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Program  PREGA 

Pivotal  Regression  Analysis 
of  Gamma-Ray  Spectra  from 
Nal(Tl)  Detectors 
for  the  N06620  Computer 


1.  INTRODUCTION 

Gamma-ray  pulse-height  spectra  from  Nal(Tl)  detectors  often  contain  few 
or  no  discernable  peaks  due  to  the  source  of  interest,  as  a  result  of  the 
poor  intrinsic  resolution  of  these  detectors  and  a  predominance  of 
background  gamma  rays.  Even  after  background  subtraction,  the  resulting 
spectrum  is  often  of  too  poor  a  quality  to  reveal  characteristic  peaks. 
Thus,  one  cannot  do  a  peak  analysis  such  as  is  usually  performed  on 
gamma-ray  spectra  from  high-resolution  germanium  diode  detectors  (see  Ref.. 
1). 

However,  there  is  often  sufficient  information  contained  in  such  spectra 
in  the  overall  spectral  shape  to  identify  the  source  of  the  gamma  rays  by 
comparison  to  a  library  of  standard  source  shapes.  The  situation  becomes 
more  complicated  when  the  spectrum  may  be  due  to  a  superposition  of 
gamma-ray  spectra  from  two  or  more  sources.  To  determine  the  relative 
contributions  of  the  individual  sources  it  is  necessary  to  do  a  multiple 
least-squares  fit  of  the  unknown  source  spectrum  to  a  library  of  standard 
source  spectra  using  regression  analysis  techniques. 

The  ALPHA-M  program  was  developed  at  Oak  Ridge^  to  perform  such  a  fit 
and  calculate  the  concentrations  of  each  of  the  standards  in  the  unknown. 

However,  if  there  are  more  than  a  very  few  standards  in  the  library, 
such  a  procedure  often  gives  an  ambiguous  result,  due  to  correlations 
between  library  spectra.  In  such  a  case,  it  is  necessary  to  do  a  systematic 
search  for  the  subset  of  library  standards  which  gives  the  best  fit  to  the 
unknown  spectrum.  Program  PREGA  was  developed  at  NRL  to  efficiently  perform 
this  search  for  the  best  subset.  It  works  in  one  of  two  optional  modes. 


The  first  mode  is  similar  to  standard  stepwise  regression  analysis 
methods.  It  begins  with  a  subset  containing  only  background,  and  performs  a 
least-squares  fit  for  the  intensity  of  the  background  in  the  unknown 
spectrum.  It  then  calculates  the  correlation  of  the  residual  spectrum,  not 
accounted  for  by  background,  with  each  of  the  remaining  standards  in  the 
library.  That  standard  with  the  largest  correlation  is  added  to  the  fitting 
subset  and  a  new  least-squares  fit  is  performed.  This  continues  until  no 
remaining  standards  are  significantly  correlated  with  the  residuals. 


The  secona  mode  begins  with  a  fit  to  the  full  library.  From  the  results 
of  this  fit  a  test  set  of  library  members  most  correlated  with  the  unknown 
spectrum  is  selected.  Additional  library  members  are  then  pivoted  in  and 
out  of  the  test  set,  depending  on  their  correlation  with  the  residuals, 
until  the  subset  which  gives  the  best  significant  fit  is  obtained.  a, 


PRE6A  begins  by  calculating  the  matrix  of  cross-correlations  of  the 

library  members  with  each  other  and  with  the  unknown  spectrum.  It  then  •>; 

operates  on  this  matrix  using  a  method  by  Garside^  to  obtain  the  ;• 

quantities  of  interest  in  the  fit  with  a  minimum  of  mathematical  •';! 

manipulations.  At  no  time  is  it  necessary  to  do  a  complete  matrix  §] 

inversion,  and  individual  library  members  can  be  pivoted  into  and  out  of  the 
fit  quickly  and  simply.  This  method  is  thus  tailor-made  for  either  the 

stepwise  mode  or  the  full  library  mode  of  PREGA.  ;N 

The  program  PREGA  is  implemented  as  an  extensive  modification  of  the  -v 

program  NAI  supplied  by  Nuclear  Data,  Inc.^  and  runs  on  the  Nuclear  Data  9^ 

ND  6620  system.  It  is  written  in  DEC  RT-11  FORTRAN  and  is  currently  being 
adapted  to  run  on  the  Digital  Equipment  Corporation  VAX  11/780.  V' 


2.  SETUP  FOR  ANALYSIS 


Preparation  of  Library 

Library  spectra  should  be  taken  for  each  source  of  interest  under 
conditions  as  close  as  possible  as  those  under  which  the  unknown  spectrum  is 
taken.  Backscattering  of  gamma  rays  by  nearby  materials  can  affect  the 
shape  of  the  spectrum  as  can  attenuation  due  to  intervening  materials 
between  the  source  and  detector.  This  results  in  removal  of  counts  from  the 
full-energy  peaks  and  the  addition  of  counts  with  lower  energy  due  to 
scattered  gamma  rays. 

Background  spectra  taken  before  and  after  each  library  spectrum  should 
be  normalized  by  counting  time  and  subtracted  from  the  library  spectrum.  An 
energy  calibration  must  be  determined  either  from  known  peaks  in  the  library 
or  background  spectra,  or  from  a  calibration  source  spectrum  taken  before 
and  after  each  library  spectrum.  Program  PKANAL  is  included  in  the  PREGA 
package  and  may  be  used  to  determine  the  position  of  the  peaks.  At  least 
two  peaks  are  needed,  well  separated  in  energy,  to  determine  a  linear 
calibration  of  peak  energy  E  versus  channel  number  I  in  the  form 


Ma 


I 


hy: 


E(I)  -  EO  +  I*E1. 


If  more  than  two  peaks  are  available  a  linear  least  squares  fit  can  be  used 
to  determine  the  offset  EO  and  slope  El.  These  should  be  recorded  with  each 
library  spectrum  along  with  source  type,  configuration,  strength,  range, 
attenuation  and  any  other  pertinent  information. 


Preparation  of  Background 


A  background  spectrum  should  be  taken  as  close  as  possible  in  time  and 
other  conditions  to  the  unknown,  preferably  immediately  before  and  after. 
An  energy  calibration  should  be  obtained  in  the  same  manner  as  for  tne 


rJA 


library  spectra.  Program  6SHIFT  can  then  be  used  to  shift  the  slope  ana 

offset  of  each  library  member  to  match  the  slope  and  offset  of  the  unknown 
spectrum.  PREGA  has  the  option  of  subtracting  the  background  from  the 

unknown  before  fitting.  Nevertheless,  the  background  spectrum  should  be 
included  in  the  library,  because  background  intensity  changes  could  lead  to 
over  or  under  subtraction.  If  this  happens,  a  negative  intensity  may  result 
for  the  background.  To  allow  for  this  PREGA  has  the  option  of  not  allowing 
the  background  to  be  pivoted  out.  (A  negative  intensity  for  any  other 
library  member  is  generally  not  physically  allowable  and  should  be  rejected). 

Preparation  for  PREGA 

The  library  to  be  used  in  the  fit  is  specified  interactively  in  the 

program  SEDIT.  The  standard  name,  file  name,  counting  time  and  half-life 
activity  are  specified  for  each  library  member.  A  background  spectrum, 

which  may  be  subtracted  from  each  library  member,  must  be  specified  although 
this  is  generally  not  used. 

The  unknown  and  its  background  are  specified  interactively  in  the 
program  UEDIT.  This  also  allows  the  user  to  select  various  options  to  be 
used  in  the  fit  and  to  select  which  of  the  library  members  will  be  used. 
The  information  entered  by  the  user  in  SEDIT  and  UEDIT  are  written  to 
control  files  which  are  used  by  PREGA  to  perform  the  fit.  Thus  PREGA 
requires  no  airect  input  from  the  user  and  can  be  run  as  a  batch  job  if 
desired.  Output  is  usually  to  a  file  which  can  be  listed  later  on  the 
1 ineprinter. 


Selection  of  Mode 

If  only  one  or  two  library  members  are  expected  to  be  present  together 
in  the  unknown,  the  stepwise  mode  of  PREGA  is  usually  more  efficient  than 
the  mode  which  begins  by  using  the  entire  library  in  the  fit.  If  multiple 
library  members  may  be  present,  it  is  usually  best  to  run  both  modes.  They 
will  generally,  but  not  always,  agree  on  the  subset  of  library  members  which 
give  the  best  fit.  In  cases  where  they  do  not  agree,  correlations  between 
library  members  or  linear  combinations  of  library  members  will  be  found  to 
cause  ambiguities  in  the  fit.  Enough  information  is  printed  out  at  each 
step  for  the  analyst  to  determine  which  library  members  are  causing  the 
ambiguity.  They  can  either  be  eliminated  from  the  library  or  accepted  as 
doubtful  contributions  to  the  unknown  spectrum. 


3.  ALGORITHMS 

Partial  F  Test 

The  criterion  used  for  selection  or  rejection  of  library  members  at  each 
step  is  given  by  the  partial  F-test  statistic  Fp  defined  in  Chapter  4. 
For  convenience,  this  is  converted  to  an  equivalent  normally  distributed 
parameter  X(F)  which  gives  the  value  of  Fp  in  standard  deviations  (sigma 
units).  This  is  compared  to  a  threshold  FO  usually  set  at  2.5  sigma. 


Full  PREGA 


The  full  PREGA  algorithm  begins  with  the  fit  to  the  complete  library  ana 
selection  of  the  trial  subset  C.  It  then  goes  directly  to  the  regression  on 
the  trial  subset  C.  PREGA  then  pivots  library  elements  out  (backward  step) 
and  in  (forward  step)  successively,  based  on  the  partial  F-values,  until  a 
best  fit  is  found.  The  full  PREGA  algorithm  proceeds  as  follows: 


1.  Do  the  fit  to  the  complete  library  L. 


2.  Let  the  trial  subset  C  include  all  library  elements  I  with  a 
relative  intensity  Bj  and  error  oi(B)  such  that 


Bi/oi(B)  >  1. 


3.  Let  E  be  the  set  containing  all  library  elements  included  in 
the  fit  at  each  step.  Initially  let  £  »  C. 


4.  Let  D  be  the  set  of  elements  not  in  the  fit  at  the  beginning 
of  step  6,  below.  Initially  let  D  *  0  (empty  set). 


5.  Backward  Pivot:  to  check  for  removal  of  library  elements 
from  subset  E. 


a.  Let  C  »  E. 


b.  Calculate  partial  F  to  remove,  Fp(l),  for  all  library 
elements  I  in  C. 


c.  Let  (J)  s  min  Fp(I),  for  all  I  in  C,  and  convert 


rn 

to  X(nj  in  sigma  unil 


d.  IF:  X(F)j  <  FO, 

THEN:  remove  0,  let  E  »  E  -  0; 
ELSE:  continue. 


e.  IF:  E  ■  L-0,  (no  change  in  trial  subset) 
THEN:  end  regression  (go  to  7); 
ELSE:  continue. 


6.  Forward  Pivot:  to  check  for  addition  of  library  elements  not 
in  C  during  step  5. 


a.  Let  D  »  L-C 


b.  Calculate  partial  F  to  include,  Fp(I),  for  all  library 
elements  I  in  D. 


c.  Let  1^  (J)  s  max  Fp(I),  for  all  I  in  0,  and  convert 
to  X(nj  in  sigma  units. 


N  • 
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d.  IF:  X(F)j  >  Fa, 

THEN:  include  J,  let  E  =  E+J; 

ELSE:  continue. 

e.  IF:  E  =  C,  (no  change  in  trial  subset) 

THEN:  end  regression  (go  to  7); 

ELSE:  repeat  pivots,  go  to  5. 

7.  End  regressionr  do- arralysts  of  variance,  calculate  residuals 
and  runs,  and  print  out  results. 

Stepwise  PREGA 

The  stepwise  PREGA  mode  is  implemented  as  an  option  of  program  PREGA. 
It  is  run  by  setting  the  Background  Regression  (BR)  parameter  in  UEDIT  to 
1:  trial  set  »  background  only.  The  stepwise  mode  proceeds  as  follows: 

1.  Begin  regression  with  fit  to  background  only. 

2.  Let  the  trial  subset  C  *  (background). 

3.  Initial ly  let  E  =  C. 

4.  Go  to  the  forward  pivot  (step  6)  of  the  full  PREGA  mode  and 
proceed  from  there  on  as  in  the  full  PREGA. 


4.  FORMULAS  AND  DEFINITIONS 


1.  Let  Y  be  the  vector  of  the  observed  source  data  spectrum. 


Y  »  |y(l),y(2),...,y(N)} , 


and  let  Xj  be  a  similar  vector  for  the  spectrum  of  library  element  I. 

2.  Define  the  augmented  cross-product  matrix  Sl  of  dimension  K,  where 
the  number  of  library  elements  is  K-l,  by 


)l  =  {^Ij}  I»  J  =  1»  ....  K 


where 


St  1  «  (Xf  .  St),  for  I,  0=1,  ...,  K-l 


and  the  dot  product 


N 

(Xj  .  Xj)  =  ^  w(r)  Xj(r)  Xj(r) 

The  weights  w(r)  are  calculated  by  the  inverse  Poisson  variances  of  the  data 
y(r). 

3.  The  least  squares  solution  for 

Y  =  8  X  +  e, 

where  e  is  the  vector  of  random  errors  in  the  data,  is  given  by 


B  =  (X-X)-1{X*Y) 


where  B  is  the  vector  of  coefficients  of  the  library  elements  in  the  fit. 


4.  The  residual  sum  of  squares  is  given  by 


RSS  =  (Y  -  8X)T-(Y  -  BX) 

»  (Y‘Y)  -  {X*Y)T(X-X)-1(X*Y). 


5.  The  results  of  a  regression  of  Y  on  a  subset  C  of  the  library  L  can 
be  completely  determined  from  the  matrix  Sc*  obtained  by  successive  pivots 
i  on  the  matrix  Sl,  for  each  library  element  in  C.  The  pivot  operation 
used  in  PREGA  is  described  by  Garside.3  The  results  for  N  data  points  and 
P  elements  I  in  C  are 


B 


I 


=  s 


★ 

IK 


RSSc  = 


it 


RSSp/(N-P) 


6.  The  partial  F-test^  to  remove  library  element  I  from  C  is  given, 
for  H  =  C-I,  by 


F  "(I)  =  (RSS^  -  RSS^)/(RSS(,/(N-P)) 


■k  * . 


then 


=  (N-P)(Sj^  )"/(Sjj  ) 

RSS^  =  RSS(.  (1  +  Fp"/(N-P)). 


7.  The  partial  F  test  to  include  library  element  J  not  in  C  is  given, 
for  G  =  C+J,  by 


F  (J)  =  (RSS(.  -  RSSg)/(RSSg/(N-P-l)) 


where 


RSSg  .  RSSjd  - 


and  the  partial  correlation  coefficient  of  J  and  K  given  C  is  just^ 


9  ★ .  9  *  * . 

R,.  /  -  (Sj^  )  ns.,j  ). 


'JK.C 


'JJ  “'KK 


8.  An  approximate  normal  transformation  for  F  with  D,1  degrees  of  freedom 
is  used,* 

X(F)s:  x/F  (1  -  1/4D)/(1  -  F/2D)l/2 
(note  that  for  0>>1  and  D»F  then  X  »>/?), 

9.  An  approximation  for  the  probability  of  obtaining  a  random  value  greater 
than  X  is  used,* 

Q(X)  «  Z(X)(ait  +  a2t2  +  ast^) 


where 

Z(X)  »  exp(-  x2/2)/(2ir)l/2. 

t  »  1/(1  +  px). 

and 

ai  «  .436184,  a2  *  -  .120168, 
a3  =  .937298,  p  =  .33267. 

*See  the  "Handbook  of  Mathematical  Functions,"  edited  by  M.  Abramowitz  and 
I. A.  Stegum,  Dover  Publications,  New  York  (1965). 


5.  PROGRAM  PKANAL 


Operation 


Program  PKANAL  reads  in  data  from  NO  spectral  files  ana  calculates  a 
background,  peak  positions,  width  and  area  for  selected  regions. 

Language 

The  program  is  written  in  DEC  RTll  FORTRAN  and  runs  on  the  Nuclear  Data 
ND6620  computer  under  the  MIDAS  operating  system. 

Inputs 


Oiskf ile 
Keyboard 

Outputs 

Input  Variables 

Record  la,... 
JL,  JR 

Record  2a, . . . 


logical  unit  (LU)  8,  spectral  data  in  ND  format 

LU  5,  operator  inputs  first  and  last  channels  for  up  to 
20  regions  followed  by  one  or  more  filenames  containing 
spectra  to  be  analyzed 

LU6,  table  of  results  for  each  spectrum 


lower  and  upper  limits  of  each  region  to  be  analyzed, 
one  pair  of  limits  per  record  up  to  a  maximun  of  twenty 
(20),  terminated  with  a  double  carriage  return 

filenames  for  spectra  to  be  analyzed,  one  per  record, 
terminated  with  a  double  carriage  return 


Lineprinter  Output 

Heading 

REGION  LIMITS 

PEAK  LIMITS 

HEIGHT 

AREA 

BKGO 

CENTROID 

VARIANCE 

FWHM 


Contents 

input  limits  (JL,JR)  for  region 

limits  determined  by  the  program  for  the  peak 

maximum  peak  height  above  background 

net  peak  area  above  background 

background  area  beneath  the  peak 

calculated  peak  position  (center  of  gravity) 

calculated  variance  about  centroid 

peak  full  width  at  half  maximum 

calibrated  energy  of  centroid  position 


ENERGY 


Subroutines  Called 


FREEFM 

GET 

PEAKNL 


Operation 


free  field  input  routine 

reads  spectrum  from  NO  spectral  files 

does  peak  analysis  for  each  region 

6.  PROGRAM  GSHIFT 


Program  GSHIFT  reads  in  a  spectrum  and  its  energy  calibration  from  disk, 
performs  a  specified  gain  shift  and  zero  offset,  and  writes  the  shifted 
spectrum  and  its  calibration  back  to  disk. 

Language 

The  program  is  written  in  DEC  RTll  FORTRAN  and  runs  on  the  Nuclear  Data 
ND6620  computer  under  the  MIDAS  operating  system. 

Inputs 

Oiskfile  logical  unit  (LU)  8,  spectral  data  in  ND  format 

Keyboard  LU5,  operator  inputs  filenames  and 

selects  new  gain  or  desired  shift 

Outputs 

Oiskfile  LU8,  shifted  spectrum  in  ND  format 

CRT  LU5,  prompts  to  operator,  energy  calibration  from 

header,  etc. 


Input  from  Keyboard 

Rec.  Prompt  Response 

1.  FILENAME  FOR  FILE. ELEMENT  (for  input  spectrum) 

SPECTRUM 


2a.  ENERGY  CALIB. 
FROM  HEADER 
GIVES  .... 
USE  THIS  .  .  . 


YES  (go  to  3a. ),  or 
NO  (go  to  2b), 
(default  =  NO)* 


2b. 


ENTER  OLD 
SLOPE,  OFFSET 


slope,  offset 

(for  calibration  of  input  spectrum) 


7.  PROGRAM  PREGA 


Operation 


Program  PREGA  performs  a  stepwise  or  pivotal  regression  analysis  in 
order  to  fit  a  data  spectrum  to  the  “best"  subset  of  a  library  consisting  of 
a  bacicground  spectrum  and  several  characteristic  source  spectra.  The 
program  is  essentially  a  modification  to  the  Nuclear  Data  Inc.  ND6600  NAI 
Data  Reduction  Package, 5  designed  to  make  analysis  more  efficient  for  the 
user.  Therefore,  the  basic  package  architecture  used  by  Nuclear  Data  Inc. 
is  still  retained  as  far  as  program  input,  file  structure  and  logical  units 
used  is  concerned.  The  general  flow  of  PREGA  is  given  in  the  flow  chart  in 
Fig.  1.  A  more  detailed  flow  chart  is  given  in  Appendix  B. 

Language 

The  program  is  written  in  DEC  RTll  FORTRAN  and  runs  on  the  Nuclear  Data 
ND6620  computer  under  the  MIDAS  operating  system. 

The  program  PREGA  does  not  accept  information  directly  from  the  user  to 
perform  its  calculations;  parameters  and  calculation  options  are  entered 
through,  and  edited  by,  the  editor  programs  SEDIT  and  UEDIT.  All  spectral 
data  acguired  by  the  user  are  stored  on  disk  files  and  automatically  read  by 
PREGA;  the  user  has  only  to  indicate,  via  the  editor  programs,  the  locations 
of  the  spectral  data. 

For  the  purposes  of  this  discussion,  all  input  data  may  be  grouped  into 
six  categories: 

(1)  spectral  data 

(2)  individual  library  standard  parameters 

(3)  all  library  standard  parameters  and  calculation  options 

(4)  sample  spectrum  parameters 

(5)  sample  background  parameters  and  calculation  options 

(6)  weighting  factor  calculation  options 

On  the  following  pages  are  listed  all  the  necessary  input  data  for  the 
PREGA  Program;  where  user  options  are  available,  they  are  mentioned. 

For  a  more  complete  description  of  the  input  data,  the  user  is  referred 
to  the  section  containing  the  listings  and  descriptions  of  the  programs 
UEDIT  and  SEDIT.  The  actual  use  of  UEDIT  and  SEDIT  by  PREGA  is  referred  to 
in  the  section  on  software  organization. 

(1)  Spectral  Data 

Gamma-ray  spectra  are  acquired  by  the  user  in  the  laboratory  and 

written  on  a  disk  file  in  spectral  data  format. 

(2)  Individual  Library  Standard  Parameters 

a.  (standard  number:  1  to  10  assigned  by  SEDIT  in  sequential  order) 
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b.  standard  name:  8  characters  maximum 

c.  location  of  individual  standard  spectrum  on  disk  file  LU-8: 

FILE. ELEMENT(, DEVICE) 

d.  half-life 

e.  half-life  units:  or  S 

f.  counting  time  in  seconds 

g.  activity  (concentration):  usually  set  to  1,  or  may  be  set  to 
convenient  units 

(3)  All  Library  Standard  Parameters  and  Calculation  Options 

a.  number  of  channels  per  standard:  maximum  512 

b.  initial  channel  number 

c.  final  channel  number 

d.  location  of  background  spectrum  on  disk  file  LU-8: 

FILE. ELEMENT(, DEVICE) 

e.  counting  time  for  background  spectrum,  in  seconds 

f .  background  subtracted  from  spectrum:  Yes  or  No  ? 

g.  number  of  isotopes  used  from  library 

h.  printout  order  of  library  standards 

i.  library  standard  rejection  coefficient;  usually  B/a  <  1 

j.  rejection  coefficient  applied  Yes  or  No? 

k.  F-test  rejection  coefficient;  usually  set  to  2.5 

(4)  Sample  Spectrum  Parameters 

a.  location  of  sample  spectrum  on  disk  file  LU-8: 

FILE. £LEMENT(, DEVICE) 

b.  counting  time,  in  seconds 

c.  volume  reduction  factor;  usually  set  =*  1 

d.  decay  time,  in  seconds;  set  »  1 

e.  result  multiplication  factor;  usually  set  *  1 

(5)  Sample  Background  Parameters  and  Calculation  Options 

a.  location  of  sample  background  spectrum  on  disk  file  LU-8: 
FILE.ELEMENT{,DEVICE) 

b.  background  supplied:  Yes  or  No 

c.  is  background  to  be  subtracted  from  the  sample  spectrum  Yes  or 
No 

d.  counting  time  of  background  spectrum,  in  seconds 

(6)  Weighting  Factor  Calculation  Options 

a.  How  determined;  user  has  2  options: 

option  1:  based  on  original  spectral  counts  and  held 
constant 

option  2:  based  on  least-squares  spectrum  counts 

b.  weighting  factor  calculation:  user  has  3  options 

(p-j  »  weighting  factor,  y^  =  sample  counts,  bi  = 
normalized  bkg  counts) 


option  1: 

Pi  -  1/yi 

option  2: 

Pi  -  l/(yi-^bi) 

option  3: 

Pi  ■  1 

Outputs 


The  output  device,  usually  a  line  printer,  prints  out  the  following 
items  in  the  order  indicated:  (see  examples  in  Appendix  A). 

(1)  sum  of  standards 

(2)  sample  spectrum  counts  in  each  channel 

(3)  sum  of  background  and  sample  counts 

*(4)  “BACKGROUND  NOT  INCLUDED  AS  A  STANDARD" 

*{5)  "PIVOT  ON  BACKGROUND  PERMITTED" 

(6)  correlation  matrix 

*l7)  "STARTING  ANALYSIS  WITH  TRIAL  S£T=BACKGROUND  ONLY" 

(8)  Result  of  current  regression 

(9)  Final  Result 

(10)  LLNL  R-STATISTIC 

(11)  Final  Statistics  for  eliminated  standards 

(12)  residuals/standard  deviations  per  channel 

(13)  suspicious  channels 

(14)  Distribution  of  residuals 

(15)  Distribution  of  Runs 

(16)  locations  and  sizes  of  large  runs 

♦These  items  are  intended  as  visual  flags  in  the  output  for  the  analyst. 

(1)  "SUM  OF  STANDARDS" 

For  each  standard  nuclide  in  the  complete  library,  the  program 
gives  the  total  number  or  counts  in  all  channels  recorded  during  the 
counting  time  of  the  radionuclide.  These  sums  are  printed  out  in  the  same 
order  as  the  nuclides  appear  in  the  library.  For  the  example  shown  in 
Appendix  A,  the  complete  library  contained  five  (5)  standards.  In  fitting 
the  sample  spectrum  only  four  (4)  of  these  standards  are  actually  used. 
This  is  the  last  stage  of  the  program  in  which  the  complete  library  is 
handled.  All  subsequent  calculations  only  use  the  library  standards  (in  the 
order  in  which  they  are  listed  in  variable  OR)  given  in  the  program  UEDIT. 

(2)  “SAMPLE  SPECTRUM" 

On  the  first  line  is  printed  the  disk  file  location  (LU-8)  of  the 
sample  spectrum  FILE. ELEMENT(, DEVICE).  The  sample  counts  minus  the 
background  counts  for  each  channel  are  then  printed.  The  background  counts 
are  multiplied  by  the  ratio  of  the  counting  time  of  the  sample  counting 
time  of  the  background  to  correct  for  any  differences  in  counting  times. 
The  printout  should  be  read  horizontally  from  left  to  right. 

(3)  "BACKGD  SUM"  and  "SAMPLE  SUM" 

These  are  the  background  and  sample  counts  in  each  channel  (see 
"SAMPLE  SPECTRUM"  listed  above)  summed  from  the  initial  channel  for 
computation  to  the  final  channel  for  computation.  See  page  36,  program 
lines  129  and  134. 


(4)  "BACKGROUND  NOT  INCLUDED  AS  A  STANDARD" 


This  is  an  output  flag  that  is  printed  only  when  the  background  is 
not  included  as  one  of  the  selected  library  standards.  **N0TE**  For  this 
flag  to  be  functional  the  background  spectrum  must  be  standard  No.  1  in  the 
complete  library  list.  The  user  is  referred  to  the  section  on  the  program 
SEDIT. 

(5)  "PIVOT  ON  BACKGROUND  PERMITTED" 

This  flag  is  output  when  the  variable  BP  in  UEDIT  is  set  equal  to 
one  (BP  =  1).  It  means  that  the  user  wants  to  allow  the  program  to  perform 
pivot  operations  on  the  background  if  the  calculation  allows  them.  ♦^NOTE*'* 
This  flag  requires  the  background  spectrum  to  be  standard  No.  1  in  the  full 
library  (see  SEDIT). 

(6)  “CORRELATION  MATRIX" 

Tnis  matrix  is  calculated  to  show  the  correlation  of  the  user 
chosen  set  of  standards  with  themselves  and  the  sample.  The  standards  are 
output  in  the  order  given  by  the  variable  OR  in  UEDIT.  The  sample  always 
occupies  the  last  row  and  column  of  the  matrix. 

(7)  “STARTING  ANALYSIS  WITH  TRIAL  SET  =  BACKGROUND  ONLY" 

This  flag  is  output  when  the  user  wishes  to  begin  the  regression 

with  the  trial  set  chosen  to  be  only  the  background  spectrum  (UEDIT  variable 

8R  »  1).  In  this  case  PREGA  executes  in  a  manner  similar  to  a  step-wise 

regression  (STREGA).  **N0TE**  This  option  flag  requires  that  the  background 
spectrum  is  standard  No.  1  in  the  full  library  set  (see  SEDIT). 

(8)  Results  of  current  regression 

This  section  of  output  contains  several  pieces  of  information. 
These  are: 

a)  A  title  line  stating  the  type  of  regression  or  pivot  operation 
just  completed; 

b)  The  degrees  of  freedom.  Regression  Sum  of  Squares  (RSS)  and 
Mean  Sum  of  Squares  (MSR); 

c)  The  name  of  the  standard  and  its  relative  concentration  and 
standard  error; 

d)  The  partial  F-value  to  remove  and  associated  Q-value  and 
x-value,  and  the  new  MSR  for  each  standard. 

e)  If  the  next  operation  to  be  performed  is  a  forward  pivot,  the 
name,  partial  F  to  add  and  associated  Q-  and  x-values,  the 
square  root  of  the  partial  correlation  coefficient,  RHO,  and 
the  new  MSR,  are  output  for  each  standard  being  considered. 


(y)  FINAL  RESULT 


This  section  of  output  is  broken  down  as  follows: 


"FIT" 

The  "FIT"  is  the  reduced  statistic  and  gives  an  overall 
quantitative  value  for  the  fitting  process,  x  ^  is  computed 
by  the  program  as  follows.  The  residual  r^  in  each  channel 
(the  difference  between  the  sample  spectrum  and  the 
least-squares  spectrum)  is  computed:  r(yi-1"i).  The 

variance  in  channel  i  for  the  least-squares  spectrum  a-j  is 
then  computed  from  the  formula 

ai  =  (fi+0.1)  +  bit/f(ln/t'). 


Then  S 

i 

and  reduced  x^  is  =  (1/Df )3^rj 

i 

where  Of  »  number  of  (channels  -  standards). 

b)  "RESULTS  +  CONCENTRATIONS  AND  EST  STANDARD  ERRORS" 

The  nuclide  name,  nuclide  concentration,  and  the  estimated 
standard  error  is  printed  out  for  each  nuclide,  in  the 
"printout"  order.  The  concentration  is  in  the  same  units  as 
the  standards  in  the  nuclide  library,  and  is  the  "actual" 
concentration  determined  by  multiplying  the  "relative" 
concentration  computed  by  the  program  multiplied  by  factors 


tnat  take  into  account  sample  decay,  volume  reduction  and 
result  multiplication,  the  activity  of  the  standard,  and  sample 
and  standard  counting  times.  The  relative  standard  error  is 
multiplied  by  the  same  factors.  Also  included  in  this  section 
of  output  are  the  final  partial  F-values  and  the  corresponding 
Q-  and  x-values  for  each  standard  in  the  final  set. 


s' 


c)  "ANALYSIS  OF  VARIANCE" 

This  table  lists  the  contributions  of  the  regression  and 
residuals  to  the  total  variance.  In  it  are  given  the  degrees 
of  freedom  and  sums  of  squares  for  the  regression,  residuals 
and  total;  the  mean  sums  of  square  due  to  the  regression  and 
residuals,  and  the  overall  F-value.  The  Mean  Square  Residual 
has  an  expected  value  for  a  good  fit  of  1.0  ±  (2/Df)l/2. 


(10)  "LLNL  R-STATISTIC" 


This  output  is  the  result  of  the  analysis  of  the  residuals  from  the 
least-squares  fit.  It  gives  the  auto-correlation  statistic, ^  its 
expectation  value,  standard  deviation  and  an  approximate  associated  FAR, 
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low  value  of  the  auto-correlation  coefficient  means  that  the  distribution  of 
residuals  is  random.  As  this  value  approaches  one  (1)  the  residuals  are 
becoming  more  correlated,  indicating  a  poorer  fit  to  the  data. 

(11)  “FINAL  STATISTIC  FOR  ELIMINATED  STANDARDS'* 

This  is  a  listing  of  the  name  and  final  partial  F-value  and 
associated  Q-  and  X-value  for  each  library  standard  eliminated  from  the  set 
during  the  regression.  It  is  useful  to  determine  whether  a  standard  was 
eliminated  because  it  is  truly  uncorrelated  with  the  sample  or  the  threshold 
value  for  the  F-test  (variable  F^  in  UEDIT)  was  too  high. 

(12)  "RATIO  OF  RESIDUALS  OVER  STD  DEV  PER  CHANNEL" 

The  “residual"  in  each  channel  is  the  difference  between  the  sample 
spectrum  and  the  least-squares  spectrum  (yi-fi).  The  standard  deviation 
for  the  least-squares  spectrum  is  defined  to  be 

o.  -  [(f.  +  0.1)  +  b.t/t'(ln/t')] 

The  program  prints  out  one  ratio  for  each  channel  in  the 
least-squares  spectrum;  the  printout  should  be  read  horizontally  from  left 
to  right.  These  ratios,  when  squared,  summed  for  all  channels,  and  divided 
by  the  number  of  degrees  of  freedom  Df,  will  »  “reduced"  x^* 

An  examination  of  these  ratios  reveals  where  the  least-squares 
spectrum  f^  fits  poorly  the  sample  spectrum  y^,  since  these  ratios  will 
be  "large."  Ratios  >  10  or  three  consecutive  ratios  ^  2  ara  flagged  as 
“suspicious  channels"  and  printed  out  in  the  next  part  of  the  output. 

(13)  "SUSPICIOUS  CHANNELS" 

The  location  and  contents  of  any  suspicious  channels  are  given. 
These  are  the  channels  where  the  ratio  of  the  residual  to  the  standard 
deviation,  ri/a-j,  is  greater  than  10  or  the  central  channel  of  three 
consecutive  channels  that  are  all  greater  than  +2.  These  are  the  same 
ratios  that  are  printed  out  in  the  section  "Residuals/Standard  Deviation  per 
Channel";  the  "Suspicious  Channels"  indicates  those  channels  where  the 
least-squares  fit  is  poor.  The  “suspicious  channels"  pointed  out  may  or  may 
not  indicate  the  presence  of  an  unexpected  nuclide. 

(14)  "DISTRIBUTION  OF  RESIDUALS" 

This  is  a  histogram  plot  of  the  distribution  of  the 
residuals/standard  deviation  per  channel.  It  is  preceded  by  a  moment 
analysis  of  the  distribution  of  residuals  giving  the  "MEAN,"  "VARIANCE," 
"SKEWNESS,"  and  "EXCESS."  The  shape  described  by  the  moments  as  well  as  the 
visual  identification  of  large  residuals  can  be  used  in  determining  the 
"goodness  of  the  fit"  to  the  sample  spectrum.  In  the  present  version  of  the 
subroutine  RESID,  residuals  with  rj/a  >  5  are  put  in  the  first  or  last 
channel  depending  on  the  sign  of  the  residual. 


(15)  "DISTRIBUTION  OF  RUNS 


This  is  a  histogram  plot  of  the  number  of  positive  and  negative 
runs  in  the  residual  spectrum.  A  run  is  a  series  of  consecutive  channels  in 
the  residual  spectrum.  For  a  good  fit,  the  expected  value  for  the  number  of 
runs,  for  these  spectra,  is  Df/2  ±  (Df/4)l/2.  The  presence  of  large 
runs  or  a  low  number  of  runs  can  be  an  important  aid  in  determining  the 
randomness  of  the  residuals  and,  hence,  the  goodness  of  the  fit. 


(16)  “LOCATIONS  AND  SIZES  OF  LARGE  RUNS" 

The  last  item  in  the  PRE6A  output  is  the  location  (or  starting 
channel)  of  the  large  runs,  and  the  length  of  the  run.  The  sign  of  the 
length  denotes  whether  this  is  a  run  of  positive  or  negative  residuals.  In 
the  present  version  of  the  subroutine  RUNS  only  runs  of  absolute  length  five 
;or  greater  are  output. 


I  VARIABLES  (PREGA) 

I 

[NAME  (DIMENSIONS)  USAGE 

I 

I 

|A(10,10)  Square  matrix  to  be  inverted 


iAC(lO) 

ARR(10,64) 

ASC(60) 

B(1U) 

|bA(512) 


Activity  of  standards  from  library 

Matrix  containing  64  channels  of  (max.)  10  standard 
spectra;  for  residual  calculation 

Disk  locations  of  standard  spectra 

1 

Spectrum  for  either  standard  background  or  sample 
background,  depending  on  location  in  program 

User  option  to  do  regression  with  trial  set  consisting  of; 
=0  all  standards  chosen 
=  1  background  only 

NOTE:  FOR  BR=1;  BACKGROUND  MUST  BE  STANDARD  No.  1  IN 
THE  LIST 


C 

CC(10,10) 

CH 

CHDF 


Bit  pattern  of  standards  currently  in  regression  for 
present  pivot 

Correlation  matrix  for  standards  and  sample 
x2  value  for  least~square  spectrum 
a  CH/DN;  “reduced"  x^  for  least-squares  spectrum 
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VARIABLES  (PRE6A)  (Cont'd) 


NAME  (DIMENSIONS) 
0 

DAY 

OEF(IO) 

OF 

OG 

ON 

DR 

DT 

E 

EF{10) 

F 

Ft 

FAT 

FD 

FF 

FILE 

FMAX 

FMIN 

FP(iO) 

FPM(IO) 

FPS 

FS 


USAGE 


Bit  pattern  of  standards  removed  from  original  set 
Decay  time  of  sample  (seconds) 

Hollerith  constant  DEF  8, 

Degrees  of  freedom;  NCH-P 
Regression  degrees  of  freedom;  N 

Degrees  of  freedom;  the  number  of  channels  used  in  the 
least-squares  fit  minus  the  number  of  standard  isotopes 

Residual  degrees  of  freedom;  MF-NZ-P+1 

Total  degrees  of  freedom;  DG+DR 

Bit  pattern  integer  for  standards  currently  in  regression 
analysis 

Logical  variable  to  keep  track  of  standard  status  in 
subroutine  PIVOT 

Bit  pattern  integer  of  original  set  of  standard  nuclei 
used 

F-test  rejection  coefficient 

t/t';  counting  time  of  standard  divided  by  counting  time 
of  standard  background 

Correction  for  decay  of  sample  and  standard 

Final  F-statistic  »  XG/XR 

Logical  unit  number  8  (disk  fi le:spectra) 

Maximum  F-value  (I)  in  forward  pivot 

Minimum  F-value  (I)  in  backward  pivot 

F-value  (I)  after  doing  pivot 

F-value  (I)  for  "F-to-remove"  or  "F-to-add“ 

Partial  F-value  sent  to  subroutine  XQCALC 

t/t';  counting  time  of  sample  divided  by  counting  time  of 
sample  background 


VARIABLES  (PREGA)  (Cont'd) 


NAME  (DIMENSIONS) 

USAGE 

fX 

t/t'(l  +  t/t');  second  order  correction  term  for  time 
difference 

HA(IO) 

Half-life  of  standards  from  library:  input  library  order 

HAT (10) 

Half-life  of  standards;  printout  order 

HF(5) 

Hollerith  output  variable  for  titles 

HG 

Hollerith  output  variable  for  titles 

HH(6) 

Hollerith  output  variable  for  titles 

HR 

Hollerith  output  variable  for  titles 

HT 

Hollerith  output  variable  for  titles 

I 

Index  used  for  nuclide  and  channel  number 

U 

Beginning  of  loop  over  standards  value 

11 

End  of  loop  over  standards  value 

I  OAT 

Associated  variable  for  logical  units  9  and  11 

IF0RKL(30) 

Variable  format  statement  number  associated  with  ENCODE 
statement 

IF0RN(20) 

Variable  format  statement  number  associated  with  ENCODE 
statement 

II 

Index  used  in  library  standards  read/write  operations 

IN 

Integer  resulting  from  checking  if  standard  I  is  in  the 
current  list  before  a  pivot 

INEG 

Integer  used  to  check  sign  of  partial  correlation 
coefficient  (R2=RHO*RHO) 

IPO 

Integer  used  to  direct  program  in  next  step  after  output 
of  a  pivot  result 

IR(512) 

Suspicious  channel  number 

IS(IO) 

Printout  order  of  standards;  OR  in  UEDIT  can  change  as 
program  is  executed 

VARIABLES  (PREGA)  (Cont'd) 


NAME  (DIMENSIONS) 
ISL(IO) 

IT(IO) 

I  VAR 
J 

JJ 

JJJ 

JDF 

K 

KAC 

KRO 

LN 

LOOP 

LSK 

LW 


USAGE 

Printout  order  of  standards;  OR  in  UEDIT  never  changes 
during  execution 

Serial  order  of  standards  to  be  used  in  least-squares  fit 

Associated  variable  for  logical  units  8  and  10 

Index  used  for  nuclide  and  channel  number 

Index  used  with  ASC  for  sample  and  background  spectra 

Do  loop  counter 

Standard  set  F  minus  standard  set  D,  used  at  end  of 
backward  pivot 

Index  used  for  nuclide  and  channel  number 

Variable  associated  with  ENCODE  statement  for  format  916 

Output  residual  (Yes  =  1,  No  =  0) 

Number  of  standards  used  plus  1,  N  +  1 

Integer  to  read  64  channels  from  disk  for  residual 
calculation 

Variable  associated  with  ENCODE  statement  for  format  916 

User  option  for  weighting  factor  p-,-;  WF  in  UEDIT  if 
based  on  actual  counts 


»  1  for  Pi  =  1 

»  0  for  p-j  »  l/(sample  counts  background  counts) 
a  -1  for  Pi  a  1/ (sample  counts  1.0) 

M  Number  of  channels  of  standard  and  sample  spectra 

(max  a  512) 

MF  Final  channel  number  for  computation 

MI  Logical  unit  9  (disk  file:  nuclide  library) 

MIU  Logical  unit  11  (disk  file:  unknown  sample) 

MO  Logical  unit  6  (line  printer) 


VARIABLES  (PREGA)  (Cont'd) 


NAME  (DIMENSIONS)  USAGE 

MP  =6  logical  unit  number  of  line  printer 

MY (10)  Integer  vector  used  to  check  bit  pattern  of  current  set 

of  standards  for  a  particular  standard 

N  Number  of  standard  nuclides  to  be  fit  (max  =  9) 

N2  Maximum  channel  number  minus  two;  used  for  suspicious 

channels  calculation 

N5  Used  to  represent  one  (specified  by  program)  value  from 

IS  or  IT  array 

N6  Used  to  represent  one  (specified  by  program)  value  from 

IS  or  IT  array 

NBA  User  option  for  standard  background  subtraction;  BS  in 

UEDIT 

=  1  for  subtraction 
=  0  for  no  subtraction 

NBR  User  option  for  background;  BG  in  UEDIT 

»  1  for  background  supplied 
=  0  for  no  background  supplied 

N8S  User  option  for  sample  background  subtraction 

a  1  subtraction 
a  0  no  subtraction 

NCH  Number  of  channels  used  for  calculation;  MF-NZ+1 

NDET  a  0  dead  time  correction  (^  a  no,  1  a  yes) 

NEWST  User  option  for  application  of  rejection  coefficient;  RC 

in  UEDIT 

a  1  for  application 
a  0  for  no  application 

NIT  Carry  over  from  old  NAI  program.  To  be  eliminated  when 

SEDIT  and  UEDIT  are  restructured 

NNN  a  0  counter  index  used  in  calling  subroutine  DECAY 

NS  Number  of  standard  spectra  in  library  (maximum  a  40) 

NW  User  option  for  weighting  factor  p^;  WD  in  UEDIT 


VARIABLES  (PREGA)  (Confd) 


NAME  (DIMENSIONS) 


USAGE 


NZ 

P 

Q 

QF 

QH 

R{512) 

R2 


RE 

RHO 

RMSR 

RSS 

RT 

S(512) 

51 

52 


Initial  channel  used  for  calculation 
Number  of  standards  currently  in  regression 
Rejection  coefficient;  RC  in  SEDIT 
Q(X)  associated  with  F-values 

User  defined  threshold  channel  number,  TC  in  UEDIT 

1.  Standard  spectra  (up  to  line  493)  then 

2.  Ratio  of  residual  divided  by  standard  deviation 

Concentration  of  standard  squared  divided  by  standard 
error  of  standard  divided  by  residual  sum  of  squares; 
used  to  calculate  partial  F-values  for  PIVOT;  partial 
correlation  coefficient 

Residual  count;  RE  =  Y(J)  -  SV 

Square  root  of  partial  correlation  coefficient,  R2 

Residual  sum  of  squares  divided  by  DF 

Residual  sum  of  squares 

x2  sum  for  least-squares  spectrum 

Standard  spectra  counts;  aij 

=  2Z^iJ  sum  of  counts  for  the  sample  spectrum 
i 

SI  +  SB  *  FX;  sum  of  sample  plus  corrected  background 
counts 


SA  bji^;  least  square  sum  coefficients  for  unknown 

concentrations  Z(I)  and  sample  Y(I);  store  in  A(L,K); 
total  sum  of  squares 

SB  Sum  of  counts  for  the  sample  background  spectrum  from  the 

initial  to  the  final  channel 


SG 

SIR (50) 
SNAM(2) 


Regression  sum  of  squares 

Contents  of  suspicious  channels 

Sample  file  name  used  in  output  for  identification 


VARIABLES  (PREGA)  (Cont'd) 


NAME  (DIMENSIONS) 

SQUC 

SR 

SROl 

SRD2 

SS(IO) 


USAGE 

Used  to  check  sign  of  number  before  taking  square  root 

Residual  sum  of  squares 

an  for  correlation  coefficient  CC(I,J) 

ojj  for  correlation  coefficient  CC(I,J) 

sum  of  counts  for  standard 
isotopes  from  the  initial  to  final  channel 


ST 

STD(IO) 


Residual  sum  of  squares 


TIS2 

TIS0(20) 


TIS0T(40) 

TMO 


1.  Variance  of  the  nuclide  concentration;  input 
library  order 

2.  Corrected  standard  error  of  the  nuclide 
concentration;  input  library  order 


SUM 

Relative  nuclide  concentration,  mj 

SUM  M 

Sum  of  weighting  factors,  P^,  from  initial 
final  channel 

SV 

Least  squares  spectrum  sum,  2Zfi 

i 

SX 

Cj,  least  squares  sums  for  constant 

terms 

T 

1.  Y(I)*BA(I)*FX  defined  at  program  line 

2.  Reciprocal  of  p-j  defined  at  program  line 

3.  r  2;  residual  squared  defined  at  program 
line  480 

TB 

Counting  time  for  background 

TE 

1.  Y( J)*BA(J)*FX  used  in  calculation 

of  CHOFS 

TISl 

Hollerith  constant  to  store  "SAMP" 

Hollerith  constant  to  store  "LE  " 


Names  of  stored  nuclides  used  in  least  squares  fit;  in 
printout  order 


standard  nuclide  names;  input  library  order 


=  (0.1  +  SV);  reciprocal  of  pi  based  upon  least-squares 
spectrum 


VARIABLES  (PREGA)  (Conf d) 


NAME  (DIf€N$IQNS; 


TNAME(36) 


TST(IO) 


W(512) 


Y(513) 

Z(10) 


USAGE 

a  TMO  +  BA(J)*FX;  reciprocal  of  p-j  based  upon 
least-squares  spectrum  corrected  background;  defined  at 
program  line  484.  Redefined  at  program  line  493  as  the 
square  root  of  IMP. 

Original  location  of  sample  spectrum 

Counting  time  for  sample  in  seconds 

Counting  time  of  standard  in  seconds;  from  PREGA  library 
User  defined  result  multiplication  factor;  MF  in  UEDIT 
User  defined  volume  reduction  factor;  VR  in  UEDIT 
Sum  of  residuals  squared 
Sum  of  TMP 

Residual  squared  times  p^ 

Weighting  factors  p, 

X-value  returned  from  subroutine  XQCALC  and  checked 
against  F^ 

Final  regression  sum  of  squares  divided  by  degrees  of 
freedom 

Final  residual  sum  of  squares  divided  by  degrees  of  freedom 

Sample  spectrum  X-j 

Library  nuclide  concentration 

Nuclide  concentration  sent  to  subroutine  XQCALC 


Program  Calculations 

PREGA  is  a  FORTRAN  language  program  consisting  of  approximately  638  lines 
and  requiring  ~  52K  words  of  memory  for  execution.  The  main  calculation 
steps  used  by  the  program  to  calculate  the  best  subset  of  standards  using 
the  pivotal  regression  technique,  the  nuclide  concentration,  residuals  and 
the  statistical  analysis  of  accidental  errors  are  listed  on  the  following 
pages.  This  section  is  included  to  provide  further  understanding  of  the 
calculation  and  as  a  guide  for  future  modifications  that  may  become 
necessary  or  desirable. 
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l)=SQRT(-A(I,I)*A(LN,LN)/ON)  Relative  standard  eror  determined  from 

TST(N5)/TSA  variance  of  standard  1 


iquations  Used  in  PREGA  (FORTRAN  variables  are  underlined) 
FAT  »  tj/t' 

S(J)  »  ^ij  *  y^Sjj  -  bi(tj/t') 

SSiJl  .  5}ij 

FS  »  ts/t' 

FX  =  (ts/f  )(1  +  ts/f ) 

T(n  “  x-j  *  zi  -  bi(ts/t') 

SB  * 

SI  »  2!^xi 

A(l,K)  -  2]aikaiiwi 
SA  »  ^  x^x^wi 

SRDl  ■  okk  ■  Akk  -  (  2]  aikwi)^/ 

SRD2  -  on  *  An  -  (2 


Software  Organization 

(1)  Logical  Unit  and  Disk  File  Structure 

The  program  PREGA  and  the  two  editor  programs  SEDIT  and  UEDIT  have 
access  to  data  stored  in  disk  files  via  specific,  user-defined  logical 
units.  The  organization  of  these  programs,  disk  files,  and  logical  units  is 
shown  in  figure  2. 

The  program  PREGA  uses  logical  units  6,  8,  9,  10,  and  11.  It  shares 
logical  unit  9  with  the  SEDIT  editor  program  and  shares  logical  unit  11  with 
the  UEDIT  editor  program. 


Logical  unit  6  is  used  to  print  out  the  results  of  the  program;  it  is 
usually  a  line  printer. 

Logical  unit  8  is  a  disk  file  that  stores  spectral  data  that  have  been 
accumulated  by  the  user  in  the  laboratory.  The  program  PREGA  reads  this 
data  to  perform  its  calculations.  Each  spectrum  is  stored  in  one  disk  file 
element.  The  data  will  include  the  sample  spectrum,  the  background  spectrum 
for  the  sample,  the  standard  spectra  (up  to  9  standards  are  permitted  at 
present)  and  the  background  spectrum  for  the  standard.  The  background 
spectrum  must  be  standard  No.  1  in  the  library. 

Logical  unit  9  is  the  standard  nuclide  library  file.  The  file  contains 
information  common  to  all  nuclides  in  the  library  (the  file  "header")  as 
well  as  specific  information  about  each  nuclide  (the  "list  of  standards"). 
For  each  standard  spectrum  in  logical  unit  8  there  will  be  a  corresponding 
entry  in  the  nuclide  library  file.  The  editor  program  SEDIT  is  used  to  add, 
delete,  or  make  changes  in  this  file. 

Logical  unit  10  is  used  by  the  program  PREGA  for  temporary  storage  of 
large  data  arrays.  This  is  a  "scratch"  file. 

Logical  unit  11  is  a  disk  file  that  contains  information  about  the 
unknown  spectrum  the  user  has  acquired.  The  UEDIT  editor  program  is  used  to 
add,  delete  or  change  the  information  in  this  file. 

The  file  structures  for  logical  units  8,  9,  10,  and  11  are  shown  on  the 
following  pages.  The  file  structures  for  logical  units  9  and  11  show  two 
columns  of  program  parameter  names.  The  editor  programs  use  the  names  in 
the  first  column  and  the  program  PREGA  uses  the  names  in  the  second  column. 

The  following  relation  exists  among  sectors,  records,  words,  bytes,  and 
bits  for  all  files  defined  as  logical  units  8,  9,  10,  and  11  in  the  program 
PREGA: 

1  sector  =  64  records  =  128  words  *  256  bytes 
1  record  =  2  words  =  4  bytes  =  32  bits 
1  word  =  2  bytes 
1  byte  a  8  bits 


(la)  Logical  Unit  8 


The  program  PREGA  uses  the  GET  subroutine  to  read  each  spectrum  through 
logical  unit  8.  Each  file  element  contains  one  spectrum.  The  spectral  data 
begins  with  record  number  129  (decimal  byte  offset  512);  the  first  128 
records  (511  bytes)  in  each  file  element  are  not  used  by  PREGA.  The  first 
128  records  comprise  the  Header  section  of  Nuclear  Data  spectral  files  and 
contain  information  used  by  other  programs  (e.g.  GSHIFT,  GET,  PUT). 

The  numbering  system  is  illustrated  below  for  the  first  2  records. 


Record  129 


Record  130 


Data  type  coding  is  as  follows: 

Sptr  (Spectral  data)  The  spectral  data  from  each  channel  is  stored 
in  4  bytes.  Only  30  bits  are  used.  The  values  are  stored  as 
double  integers.  Word  1  is  the  least  significant  word. 

Regardless  of  the  number  of  bits/channel  assigned  to  an  ADC, 
each  channel  is  always  written  to  disk  as  a  32-bit  word. 

If  M  =  the  number  of  channels  of  spectral  data,  the  decimal  byte  length 
of  the  file  element  is  512  +  4*M.  The  user  can  use  this  to  determine  how 
much  disk  space  must  be  reserved  for  the  spectral  data.  For  example,  the 
maximum  number  of  channels  a  user  can  have  in  one  spectrum  is  512.  This 
would  require  2560  bytes  or  10  sectors  to  be  reserved  for  that  file 
element.  The  maximum  number  of  spectra  accessible  by  SEDIT  at  any  given 
time  is  currently  9.  The  number  of  spectra  which  can  be  stored  on  the  disk 
in  file  DATA  is  determined  by  the  size  of  file  DATA.  Because  SEDIT  is 
limited  to  9  standards,  the  maximum  number  of  spectra,  or  file  elements  a 
user  can  have  on  logical  unit  8  is  12  (see  below)  so  the  upper  limit  of  the 
size  of  this  disk  file  is  120  sectors. 

The  total  number  of  file  elements  will  be  the  sum  of: 

1  to  9  file  elements  for  the  standard  spectra 

1  file  element  for  the  standard  background  spectrum 

1  file  element  for  the  unknown  sample  spectrum 

1  file  element  for  the  unknown  sample  background  spectrum 


Word  2 

Word  1 

byte  515  byte  514 

byte  513  byte  512 

Word  2 

Word  1 

byte  519  byte  518 

byte  517  byte  516 

NOTE  -  The  program  SEDIT  can  actually  handle  up  to  40  standard  spectra. 
The  limitation  of  only  9  standard  spectra  is  caused  by  PREGA.  As  stated 
earlier,  PREGA  was  built  on  the  framework  of  the  Nuclear  Data,  Inc.  NAI 
analysis  program,  which  has  some  built-in  inefficiency.  The  method  for 
modifying  PREGA  and,  hence  the  whole  package  is  given  in  more  detail  below. 
At  present,  it  was  felt  that  9  standards  would  be  sufficient  for  the  present 
analysis  without  making  PREGA  unnecessarily  larger. 


(lb)  Logical  Unit  9 

SEOIT  writes  the  file  to  logical  unit  9  and  the  program  PREGA  reads  from 
logical  unit  9. 

The  numbering  system  is  illustrated  below  for  the  first  2  records. 


Record  1 


Word  2 

Word  1 

byte  3  byte  2 

byte  1  byte  0 

Word  2 

Word  1 

byte  7  byte  6 

byte  5  byte  4 

Record  2 


Data  type  coding  is  as  follows: 

A  ASCII  characters 

F  REAL*4  single  precision  floating  point  with  4  bytes 
1*2  INTEGER *2  with  2  bytes 
L*1  LOGICAL*!  with  1  byte 

The  number  in  the  “offset"  column  is  the  address. 

This  file  requires  256  bytes  for  the  "header"  section  and  64  bytes  for 
each  nuclide  in  the  library.  If  N  represents  the  number  of  nuclides  in  the 
library,  then  a  total  of  256  +  64N  bytes  of  storage  are  required;  one  sector 
=  256  bytes.  For  example,  the  maximum  number  of  nuclides  a  user  can  have  in 
the  library  is  9.  This  would  require  256  +  576  =  832  bytes.  An  example 
printout  of  this  file  is  given  in  the  section  about  SEDIT.  The  example 
consists  of  two  parts:  the  first  part  is  the  "PREGA  LIBRARY  HEADER"  and  the 
second  part  is  the  "PREGA  LIBRARY  STANDARDS". 


Number 

Byte 

Byte 

SEDIT 

PREGA 

■wai 

Offset 

Offset 

Length 

Name 

Name 

Parameter  Description 

Typ 

1 

0 

M 

NS 

number  of  isotopes  in  standard 
library  (max  =  9) 

1*2 

2 

4 

2 

NC 

M 

number  of  channels  per  standard 
(max  =  512) 

1*2 

3 

8 

2 

IT 

NIT 

number  of  iterations  for  threshold 
and  gain  calculation  (not  used) 

1*2 

4 

12 

2 

BS 

NBA 

background  subtract  1  =  yes, 

^  =  no 

1*2 

5 

16 

2 

IS 

NZ 

initial  channel  for  computation 

1*2 

6 

20 

2 

IE 

MF 

final  channel  for  computation 

1*2 

7 

24 

132 

space  reserved  for  file  expansion 

40 

156 

4 

BT 

TB 

counting  time  for  standard 
background 

F 

41 

160 

4 

RC 

0 

rejection  coefficient 

F 

42 

164 

30 

BA 

ASC 

standard  background  location 

L*1 

49 

194 

2 

word  2  of  record  49  not  used 

50 

196 

60 

space  reserved  for  file  expansion 

65 

256 

8 

A 

TISOT 

first  standard  isotope  name 

A 

67 

264 

30 

A 

ASC 

first  isotope  location 

L*1 

74 

294 

2 

word  2  of  record  74  not  used 

75 

296 

4 

HL 

HA 

half-life  of  first  isotope 

F 

76 

300 

4 

SEC 

TST 

counting  time  of  first  isotope 

F 

77 

304 

4 

ACT 

AC 

activity  of  first  isotope 

F 

78 

308 

12 

not  used 

81 

320 

52 

data  for  standard  isotope  two 

94 

372 

12 

not  used 

97 

384 

52 

data  for  standard  isotope  three 

no 

436 

12 

not  used 

through  65+  (NS*16)  -3 

where  NS  =  number  of  isotopes  in 

standard  library 

The  secohd  word  of  records  1,2, 3, 4, 5  and  6  is  not  used. 


(Ic)  Logical  Unit  10 


PREGA  reads  and  writes  to  the  file  of  the  logical  unit  10.  This  file,  a 
“scratch"  file,  is  used  for  temporary  storage  of  the  large  data  arrays 
manipulated  by  the  Nal  program. 

The  numbering  system  is  illustrated  below  for  the  first  Z  records. 


Record  1 


Record  2 


Data  type  coding  is  as  follows: 

Sptr  (Spectral  Data)  The  spectral  data  from  each  channel  is  stored 
in  4  bytes.  Only  30  bits  are  used.  The  values  are  stored  as 
double  integers.  Bits  14  and  15  have  been  set  for  for  word 
2,  which  is  the  most  significant  word. 


structure  of  PRE6A  File  10  {“Scratch"  file) 


Record 

Number 

Offset 

Decimal 

Byte 

Offset 

Decimal 

Byte 

Length 

PREGA 

Name 

Parameter  Description 

DATA 

Type 

1 

0 

4*M 

S 

storage  for  all  channels 

of 

first 

Sptr 

M+1 

4*M 

4*M 

S 

standard  spectrum 

storage  for  all  channels 

of 

second 

Sptr 

2*M+1 

2*4*M 

4*M 

S 

standard  spectrum 

storage  for  all  channels 

of 

third 

Sptr 

3*M+1 

3*4*M 

4*M 

S 

standard  spectrum 

storage  for  all  channels 

of 

fourth 

Sptr 

• 

• 

• 

NS*M+1 

• 

• 

• 

NS*4*M 

• 

• 

• 

4*M 

« 

« 

• 

S 

standard  spectrum 

• 

• 

storage  for  all  channels 

of  sample 

Sptr 

spectrum 

where  M  =  number  of  channels  per  standard 
NS  =  number  of  isotopes  in  standard  library 


(Id)  Logical  Unit  11 


UEDIT  writes  the  file  to  logical  unit  11  and  PREGA  reads  from  logical 
unit  11. 

The  numbering  system  is  illustrated  for  the  first  2  records. 


Word  2 


Word  1 


Record  1 


byte  3  byte  2  byte  1  byte  0 


Word  2 


Word  1 


Record  2 


byte  7  byte  6  byte  5  byte  4 


Data  type  coding  is  as  follows: 

F  REAL*4  single  precision  floating  point  with  4  bytes 
1*2  INTE6ER*2  with  2  bytes 
L*1  LOGICAL*!  with  1  byte 

The  number  in  the  “offset"  column  is  the  address. 

An  example  of  the  printout  of  this  file  is  given  in  the  section  on  UEDIT 
with  the  heading  "PREGA  UNKNOWN  SAMPLE  PARAMETERS". 


structure  of  PREGA  and  UEDIT  File  11 


Record 

Decimal 

Decimal 

Number 

8yte 

Byte 

UEDIT 

PREGA 

DATA 

Offset 

Offset 

Length 

Name 

Name 

Parameter  Description 

Type 

1 

0 

4 

dummy 

2-9 

1 

30 

UN 

ASC 

location  of  sample  spectrum 

L*1 

9 

34 

2 

word  2  of  record  9  not  used 

10 

36 

4 

GN 

FIT 

gain  shift  ratio  (not  used) 

F 

11 

40 

4 

TH 

SHOT 

threshold  shift  (not  used) 

F 

12 

44 

2 

BG 

NBR 

background  supplied  yes  =  1 
no  =  6 

1*2 

13 

48 

2 

BS 

NBS 

background  subtract  yes  =  1, 
no  =  6 

1*2 

14 

52 

4 

BT 

TB 

counting  time  for  sample 
background  (sec) 

F 

15 

56 

4 

CT 

TSA 

counting  time  for  sample  (sec) 

F 

16 

60 

4 

VR 

VRED 

sample  concentration  factor 

F 

17 

64 

4 

DT 

DAY 

decay  time  (sec) 

F 

18 

68 

4 

MF 

VM 

sample  dilution  factor 

F 

19 

72 

30 

BA 

ASC 

location  of  sample  background 

L*1 

27 

104 

2 

word  2  of  record  27  not  used 

28 

108 

2 

WD 

NW 

weighting  factor  determination: 

=  i  if  based  on  actual 

1*2 

counts/channel 
a  1  if  based  on  calculated 

counts/channel 

29 

112 

2 

NS 

N 

number  of  library  spectra  to  be 
fitted  to  the  sample 

1*2 

30 

116 

2 

Fi 

F-test  rejection  coefficient 

R*4 

31 

120 

2 

WF 

LM 

weighting  factor 
a  -1  for  (sample  counts  +1) 

1*2 

=  i  for  (sample  counts  +  back¬ 

ground  counts)**-! 

«  1  for  1 

32 

124 

2 

RC 

NEWST 

apply  rejection  coefficient 

1*2 

33 

128 

2 

BR 

BR 

start  regression  with  background 
only;  ^  «  no,  1  »  yes 

1*2 

34 

132 

2 

BP 

BP 

allow  pivot  on  background 
^  a  no,  1  a  yes 

1*2 

35 

136 

2 

RO 

KRO 

output  residuals 
^  a  no,  la  yes 

1*2 

36 

140 

32 

RS 

ASC 

ID  of  output  file  for  residuals 

L*1 

43 

176 

4*N 

OR 

IS 

library  standard  number 

1*2 

listed  in  the  order  of  desired 
printout 


N  is  the  number  of  library  nuclides  to  be  fir.  to  the  sample. 

The  second  word  of  records  12,13,27,28,29,30,32,33,34,  and  35  through  43+N 
is  not  used. 


Subroutines  Called  by  the  Program  PREGA 


The  following  eleven  subroutines  are  used  during  the  execution  of  PREGA. 
Figure  3  shows  the  hierarchy  of  subroutine  calls.  Brief  descriptions  of 
each  subroutine  are  given  below.  Listings  of  the  subroutines  are  given  in 
Appendix  B. 

(1)  GET+(ASC,  ARRAY,  IVAR,  FILE,  M) 

The  subroutine  GET  is  used  by  the  NAI  program  to  obtain  spectral  data 
from  tne  various  disk  file/elements  defined  as  logical  unit  8.  The  program 
PREGA  first  obtains  the  location  of  the  spectrum  and  sends  this  location,  as 
an  ASCII  character  string,  to  the  GET  subroutine.  GET  in  turn  calls  CONCAT 
which  concatenates  the  character  string  and  LUNDEF  subsequently  sends  the 
concatenated  string  to  the  operating  system,  MIDAS,  which  interprets  the 
string  and  performs  the  command  operation.  GET  is  a  FORTRAN  language 
subroutine,  while  the  other  two,  CONCAT  and  LUNDEF,  are  written  in  assembler 
language. 

Listings  or  descriptions  of  the  system  routines  CONCAT  and  LUNDEF  are 
given  in  Appendix  C. 

VARIABLES  (GET) 

name  (DIMENSIONS)  USAGE 

ARRaY(256)  Channel  Contents  of  Spectrum  Being  Retrieved  from  Disk 
ASC(60) 


OEF(IO) 


FILE 
I  VAR 
K 

LSB 

M 

MSB 

NAM(60) 

REl 


Location  of  spectrum  being  retrieved 
(FILE.  ELEMENT  (,  DEVICE)) 

Hollerith  constant  DEF8,  used  to  create  a  command  in  CONCAT 
and  LUNDEF 

Logical  unit  number  8  (disk  f i lerspectra) 

Associated  variable  for  logical  unit  8 

Loop  index  over  number  of  channels  in  spectrum 

Least  significant  byte  of  data  word 

Number  of  channels  in  spectrum 

Most  significant  byte  of  data  word 

Concatenated  character  string  ASC  sent  to  LUNDEF 

Most  significant  byte  of  data  word  ARRAY(K)  converted  to  R*4 

Least  significant  byte  of  data  word  ARRAY(K)  converted  to  R*4 


RE2 


(2)  HISTO  (LABEL,  IH,  XL,  XD,  N) 


The  FORTRAN  subroutine  HISTO  is  called  by  the  Subroutines  RESID  ana 
RUNS.  From  the  data  received  from  these  two  subroutines  it  generates  a 
labeled,  scaled  histogram  which  is  output  to  logical  unit  6.  The  two 
histograms  are  “DISTRIBUTION  OF  RESIDUALS"  and  “DISTRIBUTION  OF  RUNS".  This 
routine  was  written  by  G.  Phillips  at  NRL  in  June  of  1981. 


VARIABLES  (HISTO) 


NAME  (DIMENSIONS) 


USAGE 


A(50)  Data  point  character 

ASTAR  Data  point  character  '** 

ACOLON  Data  point  character 

I  Loop  index  to  skip  5  lines  after  histogram  is  output 

IDIV  Scale  factor  for  output  histogram 

IH(21)  Number  of  steps  on  x-axis  (21  MAX) 

lOUT  Logical  unit  =  6  for  output 

IT  ^Xj  for  output  histogram 

J  Y-value  for  each  channel  x 

K  Loop  over  number  of  x-values  in  histogram 

LABEL  (4)  Title  label  for  output  histogram 

MAX  Maximum  Y-value  allowed;  used  to  determine  scale  factor 

(MAX/ IDIV  <  50) 


N 

X 

XD 

XL 


Number  of  x-values  in  histogram 
First  (or  lowest)  x-value 
Step  size  of  x-values 
Lowest  x-value  from  calling  program 


(3)  PIVOT  (A,P,£,K) 

PIVOT  is  a  FORTRAN  subroutine  called  by  PREGA.  Its  purpose  is  to  produce 
the  negative  of  the  upper  triangle  of  the  inverse  of  a  square  symmetric 
matrix  oy  operating  only  on  the  upper  triangle  of  the  matrix.  The  procedure 
by  which  this  is  accomplished  is  an  adaptation  of  the  Gauss-Jordon  Method. 
On  each  entry  to  PIVOT  a  specified  diagonal  element  is  used  for  one  pivot 
operation.  To  invert  a  order  matrix  the  procedure  must  be  called  k 
times.  The  order  of  which  diagonal  element  is  pivoted  is  unimportant.  This 
routine  checks  for  a  near-zero  pivot.  All  pivots  are  done  with 
single-precision  arithmetic  with  no  significant  loss  of  accuracy.  The 
routine  was  written  in  FORTRAN  by  G.  Phillips  and  B.G.  Glagola,  NRL  in  July 
1982  from  Algorithm  AS  37  by  M.J.  Garside.^ 


NAME  (DIMENSIONS) 


VARIABLES  (PIVOT) 
USAGE 


A(10,10) 


£(10) 


Array  of  standards  and  sample  to  oe  inverted 

Reciprocal  of  the  element  about  which  the  pivot  occurs  (A(P,P)) 

A(I,P)*AA  or  A(P,I)*AA 

Variable  to  determine  which  standards  are  in  the  current  subset 

Loop  index  over  standards  with  array  index  less  than  that  of 
the  pivoting  standard  (max  PI  =  P-1) 

Loop  index  over  standards  and  sample  with  array  index  greater 
than  that  of  the  pivoting  standard  (min  P2  =  P+1) 

Number  of  standards  in  original  set  plus  one  (in  PREGA  K  =  LN 
=  N+1) 

Index  of  the  pivoting  standard 
PI  *  P-1;  loop  maximum 
P2  =  P+1;  loop  minimum 


C4)  PUT  (ASC,  ARRAY,  IVAR,  FILE,  M) 


The  FORTRAN  subroutine  PUT  was  written  by  G.  Phillips,  NRL  in  June  1981. 
PREGA  uses  PUT  to  write  the  residual  spectrum  on  disk  using  logical  unit  8. 
This  routine  also  uses  CONCAT  and  LUNDEF  to  send  a  character  string  to  the 
MIDAS  operating  system  and  perform  the  command. 


VARIABLES- (PUT) 

NAME  (DIMENSIONS)  USAGE 

ARRAY  (256)  Spectrum  to  be  output  to  disk 

ASC  (60)  Disk  location  of  spectrum 

(File.  Name  (,  Device)) 

DEF  (10)  Hollerith  constant  DEF  8,  used  to  create  a  command  in  CONCAT 

and  LUNDEF 

Logical  unit  number  8 
Associated  variable  for  logical  unit  8 
Loop  index  over  number  of  channels  in  output  spectrum 
Least  significant  byte  of  data  word  ARRAY(K) 

Number  of  channels  in  output  spectrum 
Most  significant  byte  of  data  word  ARRAY(K) 

Concatenated  character  string  ASC  sent  to  LUNDEF 
Data  word  ARRAY(K) 


FILE 

IVAR 

K 

LSB 

M 

MSB 

NAM 

V 


(5)  RESID  (R,  NZ,  MF) 

The  FORTRAN  subroutine  RESID  was  written  by  G.  Phillips,  NRL  in  June 
1981.  It  is  used  by  PREGA  to  generate  a  distribution  of  residuals  from  the 
residual/standard  deviation  spectrum  and  perform  a  moment  analysis  of  this 
distribution.  The  output  from  RESID  is  the  “MEAN  RESIDUAL",  "VARIANCE", 
"SKEWNESS",  and  "EXCESS"  of  the  distribution.  RESID  also  calls  HISTO  to 
generate  and  output  the  histogram  of  the  distribution  of  residuals. 


NAME  (DIMENSIONS) 
A(10) 

C(10) 

EX 

I 

IH(21) 

lOUT 

J 

K 

LABEL  (4) 

M 

MF 

N 

NZ 

R(256) 

SO 

SQ 

U 

U2 

U3 

U4 

V 

XO 


VARIABLES  (RESID) 

USAGE 

Moments  of  the  residual  distribution 

Constants  for  the  moment  calculations 

Excess  of  the  residual  distribution 

Index  for  loop  over  the  number  of  channels  in  the 
residual  spectrum 

Number  of  steps  on  the  x-axis  for  SUBROUTINE  HISTO 

Logical  unit  for  output  =  6 

Index  for  the  loop  to  calculate  Cj 

Index  for  yield  at  each  step  on  x-axis  for  HISTO 

Title  for  histogram  sent  to  HISTO 

Number  of  channels  used  in  calculation  plus  1 

Initial  channel  used  in  calculations 

Number  of  data  points  sent  to  HISTO 

Final  channel  used  in  calculations 

Residual /standard  error  spectrum 

Second  moment  of  residual  distribution 

Third  moment  of  residual  distribution,  skewness 

Mean  residual 

Mean  squared  residual 

Mean  cubed  residual 

Mean  fourth  power  residual 

Variance  of  residual  distribution 

Step  size  for  HISTO 

Lowest  x-value  for  HISTO 


XL 


(7)  RSTAT  (NCH,  P,  R,  NZ,  MF) 


The  subroutine  RSTAT  analyzes  the  residual/standard  deviation  spectrum 
from  PREGA  to  compute  an  auto-correlation  coefficient,  its  expectation 
value,  standard  deviation  and  an  approximate  associated  FAP.  RSTAT  uses  an 
entry  to  the  subroutine  XQCALC  to  calculate  the  associated  FAP.  This 
version  of  RSTAT  is  an  adaptation  to  PREGA  by  B.G.  Glagola,  NRL,  20  July 
1982  of  the  original  routine  written  by  T.B.  Gosnell,  LLNL,  22  June  1982. 


NAME  (DIMENSIONS) 

CH 

OF 

EP 

EXRES 

I 

MF 

MFl 

NCH 

NRMR 

NZ 

P 

0 


VARIABLES  (RSTAT) 

USAGE 

Number  of  channels  in  residual  spectrum 
Number  of  degrees  of  freedom 
Number  of  standards  in  final  set 

Expectation  value  of  residual  auto  correlation  coefficient 
Index  for  loop  over  number  of  channels  minus  one 
Final  channel  in  spectrum 
MF-1 

Number  of  channels  in  spectrum  from  PREGA 

Equivalent  normal  standard  deviations 

Initial  channel  in  spectrum 

Number  of  standards  in  final  set  from  PREGA 

Residual  statistic  “False  Alarm  Probability"  returned 
from  XQCALC 


R(512)  Residual/standard  error  spectrum  from  PREGA 

RSTT  Auto-correlation  coefficient 


SI  GRES 


Standard  deviation  of  R-statistic 


(8)  RUNS  (R,  NZ,  MF) 

The  FORTRAN  subroutine  RUNS  analyzes  the  residual/standard  deviation 
spectrum  from  PREGA  for  runs  of  consecutive  channels  with  the  same  sign.  It 
outputs  the  location  (starting  channel  of  a  run)  and  the  size  of  the  run. 
The  sign  of  the  size  indicates  a  run  of  positive  or  negative  residuals. 
RUNS  also  calls  HISTO  to  generate  and  output  a  histogram  of  the  distribution 
of  runs.  This  routine  was  written  by  G.  Phillips,  NRL,  June,  1981. 


NAME  (DIMENSIONS) 
I 

ICH 

iH(a) 

j 

K 

KSI(12) 

LABEL (4) 

MF 

N 

NCH(50) 

NRS(50) 

NZ 

R(256) 

XO 


VARIABLES  (RUNS) 

USAGE 

Index  used  for  channel  counting 

Beginning  channel  of  a  particular  run 

Counter  for  the  number  of  times  a  particular  run  length 
occurs 

Output  index  over  location  and  number  of  large  runs 
Index  for  x-axis  of  number  of  runs  histogram 
Storage  variable  for  length  of  long  runs 
Identification  label  for  histogram,  sent  to  HISTO 
Last  channel  of  spectrum  used  for  calculations 
Number  of  data  points  sent  to  HISTO 
Initial  channel  of  long  runs  for  output 
Length  of  long  runs  for  output 
Initial  channel  of  spectrum  used  for  calculation 
Residual /standard  error  spectrum  from  PREGA 
Step-size  of  x-axis  of  output  histogram 
Lowest  value  on  x-axis  of  output  histogram 


XL 


Future  Modifications  of  PREGA 


The  program  SEDIT,  as  received  originally  from  Nuclear  Data,  Inc.,  is 
capable  of  handling  up  to  40  standard  nuclides  in  the  library.  At  the 
present  PREGA  limits  the  number  of  standards  that  are  allowed  to  be  in  the 
library.  This  is  because  PREGA  was  built  on  the  framework  of  the  Nuclear 
Data,  Inc.  NAI  Analysis  Package.  In  this  package,  the  analysis  program 
(called  PREGA  now)  reads  control  parameters  first  from  SEDIT  and  then  from 
UEDIT.  Hence,  PREGA  reads  all  of  the  standards  listed  by  SEDIT  from  disk, 
and  computes  their  sums  and  does  background  corrections  before  it  reads  from 
UEDIT  which  standards  and  in  which  order  they  are  to  be  used  in  the 
regression  analysis.  To  keep  PREGA  from  becoming  unnecessarily  large,  it 
was  decided  that  nine  standards  would  be  sufficient  to  fit  a  sample 
spectrum.  To  increase  the  maximum  number  of  standards  allowed  several 
variable  dimensions  in  PREGA  and  subroutine  PIVOT  have  to  be  modified. 
Currently  these  have  the  dimension  (10)  or  (10,10)  for  arrays.  These 
variables  are  listed  below  along  with  their  identification,  with  N  =  maximum 
number  of  standards  in  the  library. 

PREGA 

A(N+1,  N+1) 

The  matrix  that  the  pivot  operations  are  carried  out  on 

AC(N) 

Activity  of  standards  from  library  in  SEDIT 

ARR(N,64) 

Matrix  containing  64  channels  of  N  standard  spectra  for 
residual  calculation 

B(N) 

i 

Correlation  matrix  for  standards  and  sample 

CC(N+1,  N+1) 

EF(N) 

Logical  variable  to  keep  track  of  standard  status  in 
subroutine  PIVOT 

FP(N) 

Partial  F-value  for  output  after  pivot 

FPM(N) 

Partial  F-to-add  or  F-to-remove 

HA(N) 

Half-life  of  standards  from  library  in  SEDIT 

HAT(N) 

Half-life  of  standard;  printout  order 

IS(N) 

Printout  order  of  standards;  OR  in  UEDIT  can 
change  during  execution 

ISL(N) 

Printout  order  of  standard;  never  changes  during 
execution 

IT(N) 

Serial  order  of  standards  to  be  used  in  least- 
squares  fit 

PKEGA  (Cont'd) 

MY(N)  Integer  vector  used  to  checK  bit  pattern  of  current 

set  of  standards  for  a  particular  standard;  NOTE  - 
values  must  also  be  added  to  DATA  statement  for  MY 

SS(N)  Sum  of  counts  over  channels  of  standard  spectra 

STD(N)  Standard  error  of  nuclide  concentration 

TIS0(2*N) ,TIS0T(2*N)  Names  of  standard  nuclides 

TST(N)  Counting  time  of  standard  in  seconds,  from  SEDIT 

Z(N)  Standard  nuclide  concentration 

NOTE:  for  neatness  of  output,  if  the  number  of  standards  is  increased  the 
I/O  statements  for  the  correlation  matrix  at  PREGA  lines  204-208  and  248-252 
must  also  be  modified. 

PIVOT 

A(N+i,  N+1)  Matrix  to  be  pivoted 

E(N)  Logical  variable  to  determine  which  standards  are 

in  the  current  subset 


8.  PROGRAM  SEDIT 


Operation 


The  standards  editor  program,  SEDIT,  is  used  to  prepare  a  file  that 
contains  control  parameters  for  the  standards  and  the  standard  library  for 
use  by  PREGA.  The  library  contains  information  about  the  name,  disk 
location,  half-life,  etc.,  about  each  standard  spectrum.  SEDIT  writes  to  a 
file  assigned  to  logTcaT  unit  9.  SEDIT  allows  the  user  to  build,  change  or 
list  the  standard  control  parameters,  and  to  also  create  a  new  library, 
insert  or  delete  a  standard,  append  new  standards  or  list  the  present 
library.  The  structure  of  the  output  file  on  logical  unit  9  is  given  in  the 
section  under  PREGA  software  organization.  A  listing  of  SEDIT  is  given  in 
Appendix  B. 

LANGUAGE 


The  program  is  written  in  DEC  RT-11  FORTRAN. 


INPUTS 

Keyboard 

Logical  unit  5,  all  operator  interaction  and  input 
is  from  keyboard 

Logical  Unit 

11 

Output  file  of  UEDIT  used  for  reading  number  of 
standards  wanted  for  fit,  for  one  standard  library 
listing  option 

Logical  Unit 

9 

For  modifying  an  existing  SEDIT  output  file 

OUTPUT 

Logical  Unit 

6 

Record  of  operator  interaction  with  SEDIT.  This 
is  usually  defined  as  the  keyboard  unit  the  operator 
is  using  for  input 

Fi le. Element 

Logical  unit  9  output  file  for  SEDIT  saved  on  disk 
for  use  with  PREGA 

A  sample  copy  of  the  output  from  SEDIT  is  given  in  Appendix  A. 


NAME  (DIMENSIONS) 


VARIABLES  (SEDIT) 
USAGE 


A(32) 

ACT 

ANS 

BA 

B6 

BS 

BT 

CC 

D 

EOT 

FNUM 

H 

HL 

I 

IE 

INT(26) 

IS 

IT 

I  VAR 
K 

L 

LA 

LD 


Isotope  name  or  file. element  disk  location 
Activity  of  standard 

Alphanumeric  answer  to  SEDIT  prompt  (e.g.  Y,  N) 

Background  spectrum  location  FILE. ELEMENT  (.DEVICE) 

=  B,  for  build  new  header  containing  standard 
control  parameters 

Background  subtract  option 

Counting  time  for  background  spectrum  in  seconds 

=  C,  to  change  one  of  the  header  parameters 

Days,  half-life  unit 

Program  pointer 

REALM  I/O  variable 

Hours,  half-life  unit 

Standard  half-life 

Index  for  program  control 

Final  channel  for  computation 

Used  to  rewrite  library  when  inserting  or 
deleting  a  standard 

Initial  channel  for  computation 

Number  of  iterations 

NOTE  -  no  longer  used,  set  »  1 

Record  number  for  direct-access  I/O 

Check  time  units  of  half-life  and  program 
pointer 

Defines  logical  unit  for  output 
Switch  program  to  append  library  mode 
Switch  program  to  delete  standard  mode 


VARIABLES  (SEDIT),  (confd) 

USAGE 

Check  for  answer  being  carriage  return  only  (to 
switch  from  header  to  library  section  or  exit  program) 

Switch  program  to  insert  standard  mode 

Switch  program  to  create  a  new  library  mode 

Switch  program  to  list  mode 

Logical  unit  to  read  UEDIT  variables  NR  and  OR 

Logical  unit  for  output  file  of  SEDIT 

Total  number  of  standards  in  library 

NS  from  UEDIT  for  list  standard  option 

OR  from  UEDIT  for  list  standard  option 

Months,  half-life  unit 

Counter  for  number  of  standards  in  library 

Number  of  channels  per  standard 

1*2  I/O  variable 

Rejection  coefficient  no  longer  used,  set  =  1 
Counting  time  of  standard  in  seconds 
YES,  I/O  answer  to  SEDIT  prompt 


9.  PROGRAM  UEDIT 


Operation 

The  unknown  sample  editor  program,  UEDIT,  is  used  to  prepare  a  file  that 
contains  control  parameters  and  information  about  the  sample  for  use  by 
PREGA.  UEDIT  writes  to  a  file  assigned  to  logical  unit  11.  The  program 
SEDIT  also  reads  the  UEDIT  output  file  to  control  an  operator  option  for 
listing  the  standard  library.  UEDIT  allows  the  user  to  Build,  Change,  or 
List  the  output  file  with  prompting  questions.  The  structure  of  the  output 
file  on  logical  unit  11  is  given  in  the  section  under  PREGA  software 
organization. 

LANGUAGE 


The  program  is  written  in  DEC  RT-11  FORTRAN 
INPUTS 


Keyboard 

Logical  Unit  11 
OUTPUTS 
Logical  Unit  6 

FILE. ELEMENT 


Logical  unit  5,  all  operator  interaction  and 
input  is  from  keyboard 

For  modifying  an  existing  UEDIT  output  file 


Record  of  operator  interaction  with  UEDIT.  This 
is  usually  defined  as  the  keyboard  unit  the 
operator  is  using  for  input 

Logical  unit  11  output  file  for  UEDIT  saved  on 
disk  for  use  with  SEDIT  and  PREGA 


A  sample  copy  of  the  output  from  UEDIT  is  given  in  Appendix  A. 


VARIASLES  (UEDIT) 


NAME  (DIMENSIONS) 

USAGE 

A(32) 

FILE. ELEMENT  location  on  disk  of  the  unknown 
sample  spectrum,  background  spectrum  or  residual 
spectrum 

ANS 

Alpha-numeric  I/O' variable 

BA 

Background  spectrum  disk  location  (FILE. ELEMENT 
(DEVICE)) 

BG 

Background  supplied  option 

BP 

Pivot  on  background  allowed  option 

BR 

Start  analysis  with  background  only  option 

BS 

Subtract  background  from  sample  option 

BT 

Counting  time  for  background  in  seconds 

CC 

Switch  program  to  change  parameter  mode 

CRT 

In  logical  unit  number  =  5 

CT 

Counting  time  of  sample  in  seconds 

DT 

Decay  time  of  sample,  set  =  1 

EOT 

Program  pointer 

Rejection  coefficient  for  partial  F  test 

FNUM 

R*4  I/O  variable 

GN 

Gain  shift  ratio  no  longer  used,  set  =  1 

I 

Index  for  loop  over  location  of  spectra 

II 

Index  for  program  control 

ITT 

Upper  bound  of  loop  for  output 

I  VAR 

Record  number  for  direct-access  I/O  to 
logical  unit  11  file 

K 

Program  control  variable 

LENGTH 

Used  as  check  for  carriage  return  to  exit 
current  mode  of  program  or  exit  program 

LL 


Switch  program  to  list  mode 


NAME  (DIMENSIONS) 
LUN 
M 
MF 

NN 

NO 

NS 

NUM 

NUMl 

OR 

RC 

RO 

RS 

SB 

TH 

UN 

VR 

WO 

WF 

YES 


VARIABLES  (UEDIT) 

USAGE 

Logical  unit  11  for  output 

First  record  of  LU  11  file 

Result  multiplication  factor  option 
(usual ly  set  =  1) 

Switch  program  to  create  a  new  file  mode 

N,  the  answer  no  to  UEDIT  prompt  question 

Number  of  standards  from  library  to  be  used  in 
lea£:t-squares  fit  by  PREGA 

1*2  I/O  variable 

Control  variable  for  record  number  in  LU-11  file 

Number  of  library  standard  in  order  of  desired 
printout 

Rejection  coefficient  for  rejection  of  standards 
used.  No  longer  used. 

Output  residuals  option 

Residual  spectrum  disk  location  (FILE. ELEMENT 
(.DEVICE)) 

Subtract  background  from  standards  option 

Threshold  shift,  no  longer  used.  Set  »  1 

Unknown  spectrum  disk  location  (FILE. ELEMENT 
(.DEVICE)) 

Volume  reduction  factor  option,  usually  set  ■  1 
Weighting  factor  determination  option 
Weighting  factor  calculation  option 
Y,  the  answer  to  a  UEDIT  prompt  question 
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PREGA- GENERAL  OUTLINE 


Figure  1. 


Summary  flow  chart  of  the  program  PREGA  showing  the  inaj 
sections  of  the  code. 
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APPENDIX  A:  Sample  Output  for  PREGA 


Sample  Output  for  Least  Squares  Analysis 

The  following  pages  contain  sample  outputs  from  the  editor  programs 
UEDIT  and  SEOIT,  and  from  the  program  PREGA.  The  listing  from  UEDIT  and 
SEDIT  are  provided  to  show  the  various  options  used  in  PREGA.  The  least 
squares  analysis  method  used  is  the  full  PREGA  mode.  This  mode  uses  a  trial 
set  of  standards  comprised  of  those  standards  which  are  most  highly 
correlated  with  the  unknown  spectrum,  as  determined  from  a  fit  to  the 
complete  library. 


I 


PREGfi  UNKNOUN  SAMPLE  PARAMETERS 

(UN)  UNKNOUN  SPECTRUM:  FILE.ELEMENTC. DEVICE) 

:  PREGA.G12161 

(GN)  GAIN  SHIFT  RATIO  :  1.00000 

(TH)  THRESHOLD  SHIFT  ;  1.00000 

(BG)  BACKGROUND  SUPPLIED  ?  :  Y 

(BS)  SUBTRACT  BACKGROUND  ?  :  Y 

(BT)  COUNTING  TIME  FOR  BACKGROUND  (SECS)  :  330.000 

(CT)  COUNTING  TIME  FOR  UNKNOUN  SAMPLE  :  430.000 

(VR)  VOLUME  REDUCTION  (OR  INVERSE  OF  DILUTION) 

FACTOR  :  1.00000 

(DT)  DECAY  TIME  :  0.000000 

(MF)  RESULT  MULTIPLICATION  FACTOR  :  1.00000 

(BA)  BACKGROUND  SPECTRUM:  FILE. ELEMENT (.DEV ICE) 

:  PREGA.B1216t 

(UD)  HOU  ARE  UEIGHTING  FACTORS  TO  BE  DETERMINED  ? 

0:  BASED  ON  ACTUAL  COUNTS/tIHANNEL. 

1:  BASED  ON  CALCULATED  COUNTS/CHN  :  0 

(NS)  NUMBER  OF  ISOTOPES  USED  FROM  THE  STANDARD  LIBRARY?: 

(F0)  F-TEST  REJECTION  COEFFICIENT.:  2.50000 

(UF)  UEIGHTING  FACTOR  CALCULATION. 

-1:  (COUNTS)**-! 

0:  (SIGMA) «*-2 
1:  1  :  0 

(RC)  REJECTION  COEFICIENT  APPLIED  ?  ;  Y 

(BR)  BACKGROUND  REGRESSION  ? 

0:  TRIAL  SET  -  CHOSEN  STANDARDS 
1:  TRIAL  SET  -  BACKGROUND  ONLY:  1 

(BP)  PIVOT  ON  BACKGROUND  SPECTRUM  ALLOWED? 

0:  NO  PIVOT  ON  BACKGROUND  ALLOWED 

1:  ALLOW  PIVOT  ON  BACKGROUND  SPECTRUM;  0 

(RO)  OUTPUT  RESIDUALS  ?:  N 

(RS)  RESIDUAL  SPECTRUM;  FILE. ELEMENT (.DEV ICE) 

:  DDATB.R31020 

(OR)  NUMBER  OF  LIBRARY  STANDARD  IN  ORDER  OF  DESIRED  PRINTOUT 
:  1  2  3  4  5  ? 


PREGfl  LIb.'s?lRY  HEADER 


(NO  NUMBER  OF  CHANNELS  PER  STANDARD  (MAX-512)  :  255 

(IT)  NUr«ER  OF  ITERATIONS  FOR  THRESHOLD  8.  GAIN  CALC. 

(BS)  BACKGROUND  SUBTRACT  ?  ;  N 

(IS)  INITIAL  CHANNEL  FOR  COMPUTATION  :  19 

(IE)  FINAL  CHANNEL  FOR  COMPUTATION  :  242 

(BT)  COUNTING  TIME  OF  BACKGROUND  (SECS.)  :  380.000 

(RC)  REJECTION  COEFICIENT  ;  1.00000 

(BA)  BACKGROUND  SPECTRUM  (F ILE.ELEMENT(. DEVICE) ) 


:  PREGA.B12161 


PREGA  LIBRARY  STANDARDS  USED 


STANDARD  *  1  :  B12161 

FILE. ELEMENT (.DEV ICE)  :  PREGA. 812161 

HALF-LIFE  (SECS):  1.0000E  09 

COUNTING  TIME  OF  STANDARD  (SECS):  3.a000E  02 

ACTIVITY:  1.0000E  00 


STANDARD  *  2  :  226RA 

FILE. ELEMENT(, DEVICE)  :  NAI.RAD45 

HALF-LIFE  (SECS):  1.0000E  09 

COUNTING  TIME  OF  STANDARD  (SECS);  1.4800E  03 

ACTIVITY;  1.0000E  00 


STANDARD  ♦  3  ;  TH232 

FILE. ELEMENT (.DEV ICE)  :  NAI.TH232 

HALF-LIFE  (SECS);  1.0000E  09 

COUNTING  TIME  OF  STANDARD  (SECS):  1.0000E  03 

ACTIVITY:  1.0000E  00 


STANDARD  *  4  :  K40 

FILE. ELEMENT (.DEV ICE)  :  NAI.K40 

HALF-LIFE  (SECS);  1.0000E  09 

COUNTING  TIME  OF  STANDARD  (SECS):  1.0000E  03 

ACTIVITY:  1.0000E  00 


STANDARD  •  5  :  PCO60 

FILE. ELEMENT (.DEV ICE)  :  NAI.PCO60 

HALF-LIFE  (SECS):  1.0000E  09 

COUNTING  TIME  OF  STANDARD  (SECS):  3.a000E  02 

ACTIVITY;  1.0000E  00 


STANDARD  ♦  7  ;  CS137 

F I LE. ELEMENT (, DEV ICE)  ;  NAI.CS137 

HALF-LIFE  (SECS):  1.0000E  09 

COUNTING  TIME  OF  STANDARD  (SECS);  1.0000E  03 

ACTIVITY:  1.00006  00 


BACKGD  SUM’ 


1.712E  05 


SAMPLE  SUM-  4.S06E  04 


*****  CORRELATION  MATRIX  ***** 


B12161 

226RA 

TH232 

K40 

PCO60 

CS137 

B12161 

1.0000 

0.9533 

0.3898 

0.4003 

0.8529 

0.5202 

226RA 

1.0000 

0.7325 

0.2955 

0.8308 

0.5252 

TH232 

1.0000 

0.3491 

0.7614 

0.4955 

K40 

1.0000 

0.3640 

0. 1447 

PCO60 

1.0000 

0.4746 

CS137 

1.0000 

G12161 

UE I GATED 

SUMS  OF  STANDARDS  AND 

UNKNOUN 

8.7470E 

01  9.4040E  01 

7.0532E 

02  4.3630E 

01 

G12161 

0.3449 

0.8462 

0.7405 

0.3216 

0.9555 

0.4954 

1.0000 


9.4290E  01  1.0245E  02  0.00006-01 
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FINAL  STATISTICS  FOR  ELIMINATED  STANDARDS 
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RATIO  OF  RESIDUALS  OVER 
/ 

STD  DEV  PER  CHANNEL  FOR 

G12161 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

0.0 

-0.  1 

1.3 

-0.4 

2.5 

-1.1 

0.4 

0.0 

-0.2 

2.2 

0.3 

0.1 

-1.2 

0.2 

-1.9 

0.8 

-1.4 

-2.4 

-2.3 

0.7 

0.7 

1.8 

0.7 

-0.2 

-0.0 

0.5 

1.7 

-1.2 

1.1 

2.1 

1.0 

-0.5 

-0. 1 

-0.6 

-0.0 

-0.8 

-1.1 

-2.6 

0.3 

-0.9 

1.9 

0.7 

1.3 

2.2 

0.5 

1.7 

0.6 

-0. 1 

0.3 

1.2 

-1.2 

0.4 

0.7 

1.9 

0.2 

0.5 

-0.4 

0.7 

-1.1 

0.4 

1.6 

-0.2 

0.2 

-1.2 

-1.6 

1.8 

-0.4 

-1.4 

-0.0 

2.1 

0.7 

1.2 

2.8 

-1.2 

2.5 

1.2 

2. 1 

0.9 

3.3 

4. 1 

3.4 

2.0 

-0.6 

-3. 1 

-1.7 

-3.0 

-2.0 

-1.3 

0.5 

2. 1 

4.8 

4.9 

5.2 

2.3 

1.8 

-0.8 

-0.9 

-5.2 

-4.2 

-2.0 

-3.0 

-1.1 

-2.7 

0.3 

0.9 

-0.6 

-0.9 

-0.3 

-1.4 

-1.4 

-2.0 

-0.7 

0.4 

0.2 

-0.8 

0.3 

-0.7 

-1.5 

-0.5 

-1.0 

0.5 

-2. 1 

-1.3 

-1.5 

-1.0 

-0.4 

-1.2 

0.6 

-0.3 

-2.0 

-1.4 

-1.0 

0.2 

-1.9 

0.1 

-1.3 

-1.4 

-1.6 

-0. 1 

1.8 

-0.6 

-1.2 

-0.3 

0.3 

-1.1 

0.5 

-0.8 

0.1 

-0.2 

1.2 

0.3 

-0.2 

1.2 

0. 1 

-0.9 

-1.1 

-0.3 

0.3 

0.7 

-0.6 

-0.8 

0.7 

1.5 

-1.7 

0.3 

-0.1 

-0.2 

-1.1 

-0.3 

0.4 

2.3 

-0.4 

-1.2 

-0.4 

1.4 

0.1 

0.7 

-0.2 

2.2 

-1.1 

0.7 

0.2 

0.8 

0.3 

1.2 

-0.5 

0.7 

0.7 

0.2 

-0.2 

1.0 

0.4 

-0.2 

1.2 

0.0 

1.2 

-0.8 

-0.5 

0.4 

0.5 

-0.3 

-1.1 

-1.3 

-1.5 

0.7 

0. 1 

-0.1 

-0.4 

0.1 

1.2 

0.2 

-0.4 

-1.9 

-0.3 

-1.6 

0.7 

0.4 

0.0 

1.0 

-0.7 

-0.9 

0.2 

-1.0 

-0.3 

-1.1 

SUSPICIOUS 

CHANNELS 

97  4. 10 

108 

4.79  109  4.91 

110  ! 

>.24 

MEAN  RESIDUAL  - 

-0.004, 

VARIANCE 

-  2. 

,045.  SKEUNESS  •  0.376  .  EXCESS  - 

70 

.■* 

’  •  '  '  '  »*•  »  ‘  «*'  •'*  -  •  »'•  «'• 
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DISTRIBUTION  OF  RUNS 
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LOCATIONS  AND  SIZES  OF  LARGE  RUNS 


Appendix  B:  FORTRAN  Listings,  DEC  RT-11 


1.  PKANAL 

2.  PEAKNL 

3.  FREEFM 

4.  GSHIFT 

5.  REGAIN 

6.  RE CHAN 

7.  SEDIT 

8.  UEDIT 

9.  PREGA 

10.  GET 

11.  HISTO 

12.  PIVOT 

13.  PUT 

14.  RESIO 

15.  RSTAT 

16.  RUNS 

17.  XQCALC 
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PROGRAM  PKANAL 

URITTEN  BY  G.U.PHILLIPS.  JULY  1991 

READS  IN  DATA  FROM  NUCLEAR  DATA  SPECTRAL  FILES 
AND  CALCULATES  PEAK  POSITIONS,  UIDTHS  AND  AREAS 
FOR  SELECTED  REGIONS 

INPUT:  JL,JR  -  LOWER  AND  UPPER  CHANNELS  FOR  PEAK  REGIONS 
ASC  -  FILENAME  FOR  SPECTRUM  TO  BE  ANALYZED 

OUTPUT:  JL.JR  -  INPUT  LIMITS  FOR  PEAK  REGIONS 
KL.KR  -  PEAK  LIMITS  (POSITIVE  NET  COUNT) 

AMAX  -  PEAK  MAXIMUM  (NET  COUNTS) 

AREA  -  PEAK  NET  AREA 

BKGD  -  BACKGROUND  AREA  BENEATH  PEAK 

CG  -  PEAK  CENTROID 

VAR  -  PEAK  VARIANCE  ABOUT  CENTROID 

FUHM  -  PEAK  FULL  WIDTH  AT  HALF  MAXIMUM 

ENERGY  -  CALIBRATED  PEAK  ENERGY 

PROCEDURES  CALLED: 

PEAKNL  -  DOES  PEAK  ANALYSIS 

GET  -  READS  SPECTRUM  AND  ENERGY  CALIBRATION  FORD  DISK 
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0001 

C 

C0MM0N/nRRAY/ARRAY(5 12) 

0002 

I NTEGER  CRT. D ATA . PER  I OD , 0LANK .JL(20),JR(20) 

0003 

COMMON/'DATA/DATA (80) /FREE/INTEG ( 16) , REALXC 16) , ALPHA (16) 

0004 

REALHC8  ALPHA. ABLANK.AHEAD(  11) 

0005 

L0GICAL«1  ASC(60) 

0006 

DATA  ABLANKxan  / 

0007 

DATA  CRT/^>'.LP/'6/'.  lN/5/.  I0UT/6/.PERI0D/'lH./',BLANK/lH  /.LUF/S/ 

0008 

p 

DATA  AHEAD^aH  REGION  .8HLIMITS  .8H  PEAK  .8HLIMITS  . 

1  8H  HEIGHT  .SH  AREA  .8H  8KGD.  , 

2  8HCENTR0ID.8HVARIANCE.8H  FliWM  . 

3  8H  ENERGY  / 

0009 

100 

IJRITE(CRT.  110) 

0010 

110 

FORMAT( IX. 'ENTER  REGIONS  BY  FIRST. LAST  CHANNEL'/) 

0011 

DO  160  1-1.20 

0012 

READ (CRT. 120) LEN. DATA 

0013 

120 

FORMAT(Q.a0Al) 

0014 

IF(LEN.LT.l)  GOTO  180 

0016 

NX-2 

0017 

MX-1 

0018 

NA-1 

0019 

CALL  FREEFM(NX.MX.NA. 1) 

0020 

JL(I)-INTEG(1) 

0021 

JR(I)-INTEG(2) 

0022 

160 

CONTINUE 

0023 

1-21 

0024 

180 

N-I-1 

0025 

C 

IF(N.LT. 1)  GOTO  990 

MIDftS  FORTRPN  IV 
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0027 

200 

0028 

0029 

210 

0030 

220 

0031 

230 

0032 

0034 

0035 

0036 

240 

0037 

0038 

250 

0039 

0040 

0041 

0042 

260 

C 

C 

0043 

0044 

300 

0045 

0046 

0047 

0048 

0049 

320 

0050 

360 

0051 

C 

0052 

990 

0053 

991 

0054 

0055 

I FORM- 1 

WRITE (CRT. 2 10) 

FORMAT(1H0,' FILENAME  FOR  SPECTRUM'/) 

READ (CRT. 230) LEN.ASC 
FORt'MT(Q.80Al) 

IF(LEN.LT. 1)  GOTO  990 

UR  I TE( I OUT. 240)  IFORM. (ASC( I) . I-1,LEN) 

FORMAT ( I 1.80A1) 

I FORM-0 

U«ITE(IOUT.250)  AHEAD 
FORMAT (2X.4A0. IX. A8.6(4X.A0) ) 

MI -256 

CALL  GET (ASC. ARRAY. IVAR.LUF.Ml. A0,B0.C0) 
URITE(CRT.260)  MI 

FORMATdX.  15.'  CHANNELS  READ  IN'/) 


DO  360  I-l.N 
KL-JL(I) 

KR-JR(I) 

CALL  PEAKNL(KL.KR.ML.MR.MX.XL.XR, 

1  AL.BL.AMAX. AREA. BKGD.CG. VAR. FUHM) 

ENERGY-A0+CG* ( B0+CG*C0 ) 

UR  I TE ( I OUT. 320 ) JL ( I ) . JR ( I ) . KL . KR. AMAX. AREA . BKGD . 
1  CG. VAR. FUHM. ENERGY 

F0RMAT(2(I8.I6.2X).1X.7G12.4) 

CONTINUE 
GOTO  220 


URITE(I0UT.991) 

FORMAT(lHl) 

STO 
END 


MIDAS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

JL 

000006 

INTEGER*2 

ARRAY  (20) 

JR 

000056 

INTEGER*2 

ARRAY  (20) 

AHEAD 

000126 

REAL>K8 

ARRAY  (11) 

ASC 

000256 

LOGICAL*! 

ARRAY  (60) 

CRT 

000362 

INTEGER*2 

VARIABLE 

PERIOD 

000372 

INTEGER*2 

VARIABLE 

BLANK 

000374 

INTEGER*2 

VARIABLE 

ABLANK 

000352 

REAL«8 

VARIABLE 

LP 

000364 

INTEL£R*2 

VARIABLE 

IN 

000366 

INTEGER*2 

VARIABLE 

lOUT 

000370 

INTEGER*2 

VARIABLE 

LUF 

000376 

INTEGER*2 

VARIABLE 

I 

000630 

INTEGER*2 

VARIABLE 

LEN 

000632 

INTEGER*2 

VARIABLE 

NX 

000634 

INTEGER*2 

VARIABLE 

MX 

000636 

INTEGER*2 

VARIABLE 

NA 

000640 

INTEGER*2 

VARIABLE 

FREEFM 

000000 

REAL*4 

PROCEDURE 

N 

000642 

INTEGER*2 

VARIABLE 

IFQRM 

000644 

INTEGER*2 

VARIABLE 

MI 

000646 

INTEGER*2 

VARIABLE 

GET 

000000 

REAL*4 

PROCEDURE 

I  VAR 

000650 

INTEGER*2 

VARIABLE 

A0 

000652 

REAL*4 

VARIABLE 

30 

000656 

REAL*4 

VARIABLE 

C0 

000662 

REAL*4 

VARIABLE 

KL 

000666 

INTEGER*2 

VARIABLE 

KR 

000670 

INTEGER*2 

VARIABLE 

PEAKNL 

000000 

REAL*4 

PROCEDURE 

ML 

000672 

INTEGER*2 

VARIABLE 

MR 

000674 

INTEGER*2 

VARIABLE 

XL 

000676 

REAL*4 

VARIABLE 

XR 

000702 

REAL«4 

VARIABLE 

AL 

000706 

REAL«4 

VARIABLE 

BL 

000712 

REAL*4 

VARIABLE 

AMAX 

000716 

REAL*4 

VARIABLE 

AREA 

000722 

REAL*4 

VARIABLE 

BKGD 

000726 

REAL«4 

VARIABLE 

CG 

000732 

REAL«4 

VARIABLE 

VAR 

000736 

REAL*4 

VARIABLE 

FUHM 

000742 

REAL*4 

VARIABLE 

ENERGY 

000746 

REAL«4 

VARIABLE 

COMMON 

BLOCK  /ARRAY/  LENGTH  004000 

ARRAY 

000000 

REAL*4 

ARRAY  (512) 

COMMON 

BLOCK  /DATA/  LENGTH  000240 

DATA 

000000 

INTEGER*2 

ARRAY  (80) 

COMMON 

BLOCK  /FREE/  LENGTH  000340 

INTEG 

000000 

INTEGER*2 

ARRAY  (16) 

REALX 

000040 

REAL«4 

ARRAY  (16) 

ALPHA 

000140 

REAL*8 

ARRAY  (16) 

ononnnnnnnnoorjnnnonoonnnnr) 
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0001 


SUBROUTINE  PEflKNL(KL.KR,ML.MR,MX.XL.XR, 

1  flL , BL . AMflX. AREA . BKGD . CG , VAR . FUHM) 

URITTEN  BY  G.U.  PHILLIPS.  JULY  1981 

FINDS  THE  AREA,  CENTER  OF  GRAVITY.  VARIANCE  AND  FUHM 

FOR  A  PEAK  IN  A  REGION  BETUEEN  KL  AND  KR 

AFTER  SUBTRACTING  A  BACKGROUND  CALCULATED 

AS  A  STRAIGHT  LINE  DRAUN  BETUEEN 

THE  MINIMUM  BELOU  THE  PEAK  AND  THE  MINIMUM 

ABOVE  THE  PEAIC. 

IF  THE  DATA  IS  FLAT  UITHIN  STATISTICS  AT  THE  MINIMUM 
THE  AVERAGE  OF  THE  THREE  CHANNELS 
INCLUDING  THE  MINIMUM  IS  USED. 

INPUT:  KL.KR  -  INITIAL  LIMITS  FOR  PEAK  REGION 

OUTPUT:  KL.KR  -  FINAL  LIMITS  FOR  PEAK  (POSITIVE  NET  COUNT) 
rt.MR  -  MINIMUM  CHANNELS  BELOU  AND  ABOVE  PEAK 
MX  -  PEAK  MAXIMUM  CHANNEL 

XL.XR  -  HALF  MAXIMUM  POINTS  BELOU  AND  ABOVE  PEAK 
AL.BL  -  SLOPE  AND  OFFSET  (FROM  fl.) 

FOR  BACKGROUND 

AMAX  -  PEAK  MAXIMUM  (NET  COUNTS) 

AREA  -  PEAK  NET  AREA 

BKGD  -  BACKGROUND  AREA  BENEATH  PEAK 

CG  -  PEAK  CENTROID 

VAR  -  PEAK  VARIANCE  ABOUT  CENTROID 

FUHM  -  PEAK  FULL  UIPTH  AT  HALF  MAXIMUM 
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C 

0002 

D 

C 

C 

C 

0003  100 

0004 
0005 
0006 
0008 
0009 

0010  110 
C 
C 
C 

0011 

0012 

0013 

0014 

0016 

0017 

0018  130 

0019 
0020 
0021 
0022 
0024 
0025 

0026  140 


COMMON/ARR A Y/AX ( 5 1 2 ) 

DATA  ICRT/5/ 

LOOK  FOR  MAXIMUM  IN  THE  REGION 

AMAX=0. 

MX*© 

DO  110  I=KL,KR 
IF(AMAX.GT.AXCn)  GOTO  110 
AMAX-AX(I) 

MX- 1 

CONTINUE 

LOOK  FOR  LOWER  AND  UPPER  MINIMA 

AMINL-AX(KL) 

ML-KL 

DO  130  I-KL.MX 

IFCAXCD  .GT.AMINL)  GOTO  130 

AMINL=AX(I) 

ML- 1 

CONTINUE 
AM I NR -AX (MX) 

MR -MX 

DO  140  I-MX.KR 

IF(AX(I) .GE.AMINR)  GOTO  140 

AMINR-AXU) 

MR-I 

CONTINUE 


78 
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C 

c 

Q 

DETERMINE  BACKGROUND  PARAMETERS 

0027 

200 

IF(ML.EQ.KL)  ML-ML+1 

0029 

J-ML-1 

0030 

K=ML+1 

0031 

SUML=0. 

0032 

SQL=0. 

0033 

DO  210  I-J.K 

0034 

FL«AX(n 

0035 

SUML-SUML+FL 

0036 

SQL-SQL+FL»>k2 

0037 

210 

CONTINUE 

0038 

IF(MR.EQ.KR)  MR-MR-1 

0040 

J=MR-1 

0041 

K=MR+1 

0042 

SUMR-0. 

0043 

SQR=0. 

0044 

DO  220  I»J,K 

0045 

FR«AX(n 

0046 

SUMR-SUMR+FR 

0047 

SQR=SQR+FR**2 

0048 

220 

CONTINUE 

0049 

DL=-AMAX1  ( ABS  ( AX(ML- 1 )  -AX(ML) ) .  ABSCAXtML+l )  -AX(ML) ) ) 

0050 

DR-AMAXl (ABS (AX(MR- 1 ) -AX(MR) ) . ABS(AX(MR+n -AX(MR) ) ) 

0051 

AL-SUML/3. 

0052 

IF(DL.LT.2.*SQL)  GOTO  240 

0054 

IF(AX(ML)  .GT.AX(ML-n)  ML»ML  -1 

0056 

AL-AX(ML) 

0057 

240 

AR-SUMR/3. 

0058 

IF(DR.LT.2.*SQR)  GOTO  250 

0060 

IF(AX(MR)  .GT.AX(MR+n)  MR-MR+1 

0062 

AR-AX(MR) 

0063 

250 

BL «( AR-AL ) /FLOAT ( MR-ML) 

D 

UR  I TE  ( I  CRT.  260 )  ML ,  MR ,  AL .  BL 

D260 

FORMAT( IX. 'BACKGROUND  PARAMETERS:  ML  MR  AL  BL'/ 

D 

P 

1  1X.2I5.2G12.4) 

c 

p 

LOOK  FOR  MAXIMUM  IN  NET  COUNTS 

0064 

MX-ML 

0065 

AMAX-AX(ML)-AL 

0066 

DO  270  I-ML,MR 

0067 

A  -AX  ( 1)  -AL-BL>«FLOAT  ( I  -ML ) 

0068 

IFCA.LT.AMAXl  GOTO  270 

0070 

AMAX-A 

0071 

MX- 1 

0072 

270 

CONTINUE 
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0073 

0074 

0075 

0077 

0078 

0079 

0080 

0081 

0083 

0084 


0085 

0086 

0087 

0088 

0089 

0090 

0091 


0092 

0093 

0094 

0095 

0096 

0097 

0098 


0099 

0100 

0102 

0103 
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C 

C  DEFINE  PEAK  LIMITS 
C 

300  KL-ML-1 

DO  310  I*ML,MX 

IF(AX<n  .LT.AL+eL*FLOAT<I-ML))  KL-I 
310  CONTINUE 

KL«MIN0(KL+1.MX) 

DO  320  I -MX.  MR 

IFCAXCn  .LT.AL+BLsKFLOATd-ft.))  GOTO  330 
KR-I 

320  CONTINUE 
C 

C  CALCULATE  PEAK  PARAMETERS 
C 

330  AI-0. 

AISQ-0. 

AREA-0. 

BKGD-0. 

CG-0. 

VAR-0. 

FUHM-0. 

D  UR  I TEC  I CRT. 3401 

D340  FORMAT(4X.' r.3X. '  COUNTS  '.3X.*  BKGD.  ',3X.*  NET 
D  1  3X.'  AREA  '.3X.*  AI  '.3X.'  AISQ  ' 

DO  360  I-KL.KR 
B-AL+BL>KFLOAT(I-MLl 
BKGD-BKGD+B 
A-AX(I)-B 
AREA-AREA+A 
AI-AI+A*FLOAT(D 
A I  SO  -  A  I  Sa+A=*<FLOAT  ( I)  )»o«2 
D  UR1TE(ICRT,350)I.AXCI).8.A,AREA.AI,AISQ 

D350  FORMATCIX. I4.6G11.3) 

360  CONTINUE 

IF (AREA. £0.0.1  RETURN 
CG -A I /AREA 

VAR  -  <  A  ISa+AREA»CG*5K2-2 .  ^A  I>CG1  /AREA 
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C 

C  FIND  FUHH 
C 


0104 

400 

AHALF=AMAX/2. 

0105 

B=AL+BL*FLOAT(KL-ML- 1 ) 

0106 

AO-AXCKL-l)-B 

0107 

DO  410  I»KL,MX 

0108 

IL-I 

0109 

B-B+BL 

0110 

A-AX(I)-B 

0111 

IF(A.GT.AHALF)  GOTO  420 

0113 

RO»A 

0114 

410 

CONTINUE 

0115 

420 

DA-A-AO 

0116 

IF(DA.EQ.0.)  DA-2.*(A-AHALF) 

0118 

X=»(A-AHALF)/DA 

0119 

XL-FLOAT(IL)-X 

0120 

L 

B-AL+BL*FLOAT(MX-ML- 1 ) 

0121 

AO-AX(MX-l)-B 

0122 

DO  430  I-MX,KR 

0123 

IR-I 

0124 

B=B+BL 

0125 

A-AXCn-B 

0126 

IF(A.LT.AHALF)  GOTO  440 

0128 

AO -A 

0129 

430 

CONTINUE 

0130 

IR-IR+1 

0131 

440 

DA-AO-A 

0132 

IF(DA.EQ.0,)  DA-2.>t<(AHALF-A) 

0134 

X-(AHALF-A)/DA 

0135 

XR -FLOAT (IR)-X 

0136 

FUHM-XR-XL 

D  UR1TE(ICRT.450)  HX.  IL.  IR.XL.XR,FIJHH 

D450  FORHATdX.'UIDTH  PARAMETERS:  MX  IL  IR  XL  XR  FUHM'/ 

D  1  1X.3I8.3G12.4/') 

C 

0137  RETURN 

0138  END 
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NAME 

OFFSET 

ATTRIBUTES 

KL 

000014 

INTEGER*2 

PARAMETER 

VARIABLE 

KR 

000016 

INTEGER*2 

PARAMETER 

VARIABLE 

ML 

000020 

INTEGER*2 

PARAMETER 

VARIABLE 

hR 

000022 

INTEGER*2 

PARAMETER 

VARIABLE 

MX 

000024 

INTEGER*2 

PARAMETER 

VARIABLE 

XL 

000026 

REAL>M 

PARAMETER 

VARIABLE 

XR 

000030 

REAL>K4 

PARAMETER 

VARIABLE 

AL 

000032 

REAL>K4 

PARAMETER 

VARIABLE 

BL 

000034 

REAL=k4 

PARAMETER 

VARIABLE 

AMAX 

000036 

REAL>K4 

PARAMETER 

VARIABLE 

AREA 

000040 

REAL-'K4 

PARAMETER 

VARIABLE 

BKGD 

000042 

REAL>M 

PARAMETER 

VARIABLE 

CG 

000044 

REAL*4 

PARAMETER 

VARIABLE 

VAR 

000046 

REAL*4 

PARAMETER 

VARIABLE 

FUHM 

000050 

REAL>K4 

PARAMETER 

VARIABLE 

I 

000052 

INTEGER*2 

VARIABLE 

AMINL 

000054 

REAL*4 

VARIABLE 

AM  I  NR 

000060 

REAL>M 

VARIABLE 

J 

000064 

INTEGER*2 

VARIABLE 

K 

000066 

INTEGER>k2 

VARIABLE 

SUML 

000070 

REAL#4 

VARIABLE 

SQL 

000074 

REAL*4 

VARIABLE 

FL 

000100 

REAL>K4 

VARIABLE 

SUMR 

000104 

REAL*4 

VARIABLE 

SQR 

000110 

REAL*4 

VARIABLE 

FR 

000114 

REAL*4 

VARIABLE 

OL 

000120 

REAL*4 

VARIABLE 

AMAXl 

000000 

REAL>»^ 

PROCEDURE 

ABS 

000000 

REAL«4 

PROCEDURE 

DR' 

000124 

REAL»4 

VARIABLE 

AR 

000130 

REALM 

VARIABLE 

FLOAT 

000000 

REALM 

PROCEDURE 

A 

000134 

REAllM 

VARIABLE 

MIN0 

000000 

INTEGER*2 

PROCEDURE 

AI 

000140 

REALM 

VARIABLE 

AISQ 

000144 

REALM 

VARIABLE 

B 

000150 

REALM 

VARIABLE 

AHALF 

000154 

REALM 

VARIABLE 

AO 

000160 

REALM 

VARIABLE 

IL 

000164 

INTEGER>k2 

VARIABLE 

DA 

000166 

REALM 

VARIABLE 

X 

000172 

REALM 

VARIABLE 

IR 

000176 

INTEGER»2 

VARIABLE 

COMMON  BLOCK  /ARRAY/  LENGTH  004000 
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0081 


0002 

0003 

0004 

0005 

0006 

0007 


0008 

0009 

0010 

0011 


0013 

0014 

0015 

0017 

0018 

0019 

0020 

0022 

0023 


SUBROUTINE  FREEFM(N,M.NA, ITYPE) 

C  LAST  REVISED  AUGUST  1981  BY  G.U.P. 

C 

C  GENERAL  SUBROUTINE  TO  DECODE  DATA  READ  IN  FREE  FIELD  FORMAT 
C  DELIMITERS  ARE  EITHER  A  BLANK  OR  A  COMMA 

C  THE  ROUTINE  ASSUMES  THE  DATA  HAS  BEEN  READ  INTO  ARRAY  IDATA  UITH 

r  TUP  PnPMOT  I'nnai'i 

C  N  IS  THE  NUMBER  OF  DATA  ELEMENTS,  MAXIMUM- 16 

C  N  IS  RETURNED  AS  THE  NUMBER  OF  DATA  ELEMENTS  FOUND 

C  M  IS  THE  LOCATION  IN  THE  ARRAY  FOR  STORING  THE  FIRST  DATA  ELEMENT 

C  M  IS  RETURNED  AS  THE  LOCATION  FOLLOUING  THE  NTH  DATA  ELEMENT 

C  NA  IS  THE  BEGINNING  COLUMN  OF  THE  DATA 

C  NA  IS  RETURNED  AS  THE  COLUMN  FOLLOUING  THE  NTH  DATA  ELEMENT 

C  ITYPE  IS  THE  TYPE  OF  DATA. 

C  1- INTEGER 

C  2 -REAL 

C  3 -ALPHANUMERIC 

C 

COMMON/'DATA/' I  DATA  ( 80 ) 

COMMON^REE/INTEG(  16)  ,REALX(  16)  .ALPHA ( 16) 

INTEGER  SEMI. E, COMMA 
REAL»8  ALPHA. BLANK 
DIMENSION  ITEMP(20).AFORM(2) 

DATA  SEM I , E . I BLK 1 . COMMA , I BLK2 . BLNK4. BLANK 


L-M 

M-M+N-1 
DO  300  I-L.M 
IF(NA.GT.a0)  GO  TO  400 
C 

C  LOOK  FOR  START  OF  CURRENT  FIELD 
C 

DO  210  J-NA.80 
JQQ-J 

IF(IDATA(J).NE.IBLK1)  GO  TO  215 
210  CONTINUE 
NA-81 
GO  TO  400 

215  IF ( IDATA (JQQ).NE. COMMA)  GO  TO  220 
NA-JQQ+1 
GO  TO  290 
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C 

C 

P 

LOOK  FOR  END  OF  CURRENT  FIELD 

0024 

220 

IL-JQQ 

0025 

ILQ  -  IL 

0026 

221 

DO  230  J-ILQ.80 

0027 

JQQ-J 

0028 

IF(IDATA(J) .EQ. IBLKl)  GO  TO  235 

0030 

IFdDATACJ)  .NE. COMMA)  GO  TO  230 

0032 

IR-J-1 

0033 

NA-J+1 

0034 

GO  TO  250 

0035 

230 

CONTINUE 

0036 

IR-80 

0037 

NA-81 

0038 

P 

GO  TO  250 

Lr 

c 

p 

CHECK  FOR  EXPONENT 

0039 

235 

IF((ITYPE.NE.2) .0R.(IDATA(JQQ-1) .NE.E)) 

0041 

ILQ  -  JQQ  +  1 

0042 

GO  TO  221 

0043 

236 

IR-JQQ  -  1 

0044 

P 

IJ-JQQ+1 

c 

p 

SET  NA  TO  START  OF  NEXT  FIELD 

0045 

L 

DO  240  J-IJ.aO 

0046 

IF<IDATA(J).EQ. IBLKl)  GO  TO  240 

0048 

NA-J 

0049 

IFCIDATACJ) .EQ. COMMA)  NA-NA+1 

0051 

GO  TO  250 

0052 

240 

CONTINUE 

0053 

p 

NA-81 

c 

p 

ENCODE  DATA  IN  CURRENT  FIELD 

0054 

250 

NI-IR-IL+1 

0055 

IFCNI.LT. 1)  GO  TO  290 

0057 

ENC0DE(NI,255.ITEMP)  (IDATA(J).J-IL,IR) 

0058 

255 

FORMAT (83A1) 
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C 

c 

0059 

GO  TO  (260,270. 280). ITYPE 

L 

c 

p 

DECODE  INTEGER  DATA 

0060 

260 

ENCODE (8. 265, AFORM)  NI 

0061 

265 

FORMATC  (I' 12,')  ') 

0062 

DECODE(NI,AFORM, ITEMP)  INTEG(I) 

0063 

P 

GO  TO  300 

L 

c 

r 

DECODE  REAL  DATA 

0064 

270 

ENCODE (8. 275. AFORM)  NI 

0065 

275 

FORMATC' (E’ 12.' .0)  ') 

0066 

DECODE ( N I . AFORM. I TEMP )  REALX ( I ) 

0067 

r 

GO  TO  300 

L 

c 

p 

DECODE  ALPHANUMERIC  DATA 

0068 

280 

IF(NI.GT.8)  NI-8 

0070 

DO  287  J-1,NI 

0071 

IFdTEMPCJ)  .EQ.SEMI)  ITEMP( J) “COMMW 

0073 

287 

CONTINUE 

0074 

ENCODE (8.288, AFORM) N I 

0075 

288 

F0RMAT('(A'.I1.')  ') 

0076 

DECODE (8. AFORM. I TEMP)  ALPHACI) 

0077 

P 

GO  TO  300 

L 

c 

p 

BLANK  OUT  REMAINING  DATA 

0078 

290 

INTEG(I)-IBLK2 

0079 

REALX(I)-BLNK4 

0080 

ALPHA(I)-BLANK 

0081 

300 

CONTINUE 

0082 

M-M+1 

0083 

P 

RETURN 

c 

p 

BLANK  INPUT.  BLANK  OUT  ALL  DATA 

0084 

400 

DO  410  J-I.M 

0085 

INTEG(J)-IBLK2 

0086 

REALX(J)-BLNK4 

0087 

ALPHA (J) -BLANK 

0088 

410 

CONTINUE 

0089 

M-I 

0090 

N-M-L 

0091 

RETURN 

0092 

END 
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NAME 

OFFSET 

ATTRIBUTES 

I  TEMP 

000024 

INTEGER*2 

ARRAY  (20) 

AFORM 

000074 

REAL>K4 

ARRAY  (2) 

N 

000014 

INTEGER>K2 

PARAMETER 

VARIABLE 

M 

000016 

INTEGER*2 

PARAMETER 

VARIABLE 

NA 

000020 

INTEGER»2 

PARAMETER 

VARIABLE 

I  TYPE 

000022 

INTEGER>K2 

PARAMETER 

VARIABLE 

SEMI 

000104 

INTEGER*2 

VARIABLE 

E 

000106 

INTEGER*2 

VARIABLE 

COMMA 

000112 

INTEGER#2 

VARIABLE 

BLANK 

000122 

REALMS 

VARIABLE 

IBLKl 

000110 

INTEGER*2 

VARIABLE 

IBLK2 

000114 

INTEGER*2 

VARIABLE 

BLNK4 

000116 

REAL«4 

VARIABLE 

L 

000210 

INTEGER«2 

VARIABLE 

I 

000212 

INTEGER»2 

VARIABLE 

J 

000214 

INTEGER*2 

VARIABLE 

JQQ 

000216 

INTEGER*2 

VARIABLE 

IL 

000220 

INTEGERiK2 

VARIABLE 

ILQ 

000222 

INTEGER*2 

VARIABLE 

IR 

000224 

INTEGER'S 

VARIABLE 

IJ 

000226 

INTEGER*2 

VARIABLE 

NI 

000230 

INTEGER#2 

VARIABLE 

COttlON  BLOCK  /DATA/  LENGTH  000240 


I DATA  000000  INTEGER»2  ARRAY  (80) 

COMMON  BLOCK  /FREE/  LENGTH  000340 

INTEG  000000  INTEGER*2  ARRAY  (16) 

REALX  000040  REAL«4  ARRAY  (16) 

ALPHA  000140  REAL«8  ARRAY  (16) 
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C  PROGRAM  GSHIFT 

C  URITTEN  BY  G.U.PHILLIPS.  AUGUST  1981 

C 

C  READS  IN  DATA  FROM  NUCLEAR  DATA  SPECTRAL  FILES 
C  AND  PERFORMS  A  GAIN  AND  ZERO  OFFSET  ADJUSTMENT 
C 

0001  DIMENSION  S(256) ,R(2565 

0002  INTEGER  CRT, DATA, PERIOD. BLANK 

0003  COMMON/DATA/'DATA  <  80 ) /FREE/I NTEG (16), REALX  CIS), ALPHA (16) 

0004  C0MM0N/'HEAD^IHDR.TI71.E(32).  ID(8),ELTIME, PLTIME, ERTIME.PRTIME 

0005  INTEGER*2  TITLE. ID. DUMT(32) ,DUMID(8) 

0006  REAL«8  JLPHA.ABLANK,AHEAD(10) 

0007  LOG  I CAL* 1  ASC(60),YES 

0008  DATA  CRT/5/',LP/6/.  IN/5/.  lOUT/S/'.PERIOD/'lH.-'.BLANK^lH  /,LUF/8/ 

0009  DATA  AHEAD/8H  REGION  .BHLIMITS  ,8H  PEAK  .8HLIMITS  , 

1  BH  HEIGHT  .BH  AREA  ,BH  BKGD,  , 

2  BHCENTROID.BHVARIANCE.BH  FUHM  / 

0010  DATA  8LNK4/4H  /.ABLANK/8H  /.YES/IHY/ 
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0011 

0012 

0013 

0014 

0015 

0017 

0018 

0019 

0020 

0021 


0022 

0023 


0024 

0025 

0026 

0028 


0030 

0031 

0032 

0033 

0034 

0035 

0036 

0037 

0039 

0040 

0041 

0042 

0043 

0045 

0047 

0048 

0049 

0050 

0051 

0052 

0053 

0054 

0055 

0056 


C 

C 

100  URITECCRT. 110) 

110  FORMATCIHO.' FILENAME  FOR  SPECTRUM'/) 

READCCRT, 120)LEN.ASC 
120  FORTWTCQ.aOAl) 

IF(LEN.LT.l)  GOTO  990 

LUF-8 

NCH-256 

CALL  GETCASC.R. IVAR.LUF.NCH.A0,B0,C0) 

URITECCRT. 130)  NCH 

130  FORMATdX.  15.'  CHANNELS  READ  IN'/) 

D  URITEdOUT.  140)  (RCD.I-l.NCH) 

D140  FORWTdHl,  10G12.3/(1X.  10G12.3)) 

D  URITECIOUT. 150) 

D150  FORMATdHl) 

IJ?ITE(CRT, 160)80, A0.C0 

160  FORMATdX. 'ENERGY  CALIBRATION  FROM  HEADER  GIVES  SLOPE.OFFSET 

1  . 'CURVATURE; '/3G 12. 4/ 

2  IX. 'USE  THIS  FOR  OLD  SLOPE  AND  OFFSET,  YES  OR  NO?'/) 
READCCRT, 170)LEN,ASC 

170  FORMAT(Q,30A1) 

IFCLEN.LT.l)  GOTO  200 
IFCASCCl) .EQ.YES)  GOTO  300 
C 
C 

200  A0-0. 

80-1. 

C0-0. 

URITE<CRT.210) 

210  FORMATdX. 'ENTER  OLD  SLOPE.OFFSET'/) 

READ (CRT. 220) LEN, DATA 
220  FORMATCQ.SOAl) 

IFCLEN.LT.l)  GOTO  300 

NX-2 

MX-1 

NA-1 

CALL  FREEFM(NX.MX,NA,2) 

IFCREALXCl)  .NE.BLNK4)  B0-REALXd) 

IF(REALX(2) .NE.BLNK4)  A0-REALXC2) 

300  DO  230  1-1.32 
DUMTCD-TITLECI) 

230  CONTINUE 

DO  235  1-1,8 
DUMIDCD-IDCI) 

235  CONTINUE 

IDELT-ELTIME 

IDPLT-PLTIME 

IDERT-ERTIME 

IDPRT-PRTIME 


iS 


ty  4*01 


F  T 
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0057 

WRITE (CRT. 3 10) 

0058 

310 

FORMAT('0TO  GET  NEW  SLOPE  AND  OFFSET  FROM 

1  '  ENTER  FILENAME’S) 

SPECTRAL  1 

0059 

READ (CRT. 320 )LEN,ASC 

0060 

320 

FORMAT(Q.80A1) 

0061 

IF(LEN.LT.l)  GOTO  350 

0063 

KUF-8 

0064 

MCH«256 

0065 

CALL  GET( ASC . S. JVAR . KUF , MCH. A 1 , 8 1 . C 1 ) 

0066 

URITE(CRT.330)81.A1.C1 

0067 

330 

FORMAT ('  HEADER  GIVES  SLOPE. OFFSET. CURVATURE ; '/3F 12 

1  ’  USE  THIS  FOR  NEW  AND  OFFSET.  YES  OR 

NO?'/) 

0068 

READ (CRT. 340)  LEN.ASC 

0069 

340 

FORMAT (Q. 8081) 

0070 

IF(LEN.LT.l)  GOTO  350 

0072 

r 

IF(ASC(1) .EQ.YES)  GOTO  400 

0074 

350 

Al-0. 

0075 

81-1. 

0076 

Cl-0. 

0077 

WRITE (CRT. 355) 

0078 

355 

FORMAT( IX. 'ENTER  NEW  SLOPE. OFFSET’/) 

0079 

READ ( CRT. 360 ) LEN . DATA 

0080 

360 

FORMAT(Q.a0Al) 

0081 

IF(LEN.LT.l)  GOTO  370 

0083 

NX-2 

0084 

MX-1 

0085 

NA-1 

0086 

CALL  FREEFM(NX.MX.NA.2) 

0087 

I F ( REALX ( 1 ) . NE . BLNK4)  8 1 -REALX( 1 ) 

0089 

IF(REALX(2) .NE.BLNK4)  A1-REALX(2) 

0091 

r 

GOTO  400 

0092 

370 

G-1. 

0093 

EPS-0. 

0094 

WRITE (CRT. 380) 

0095 

380 

FORMAT( IX. 'ENTER  GAIN. ZERO  SHIFT’/) 

0096 

READ ( CRT. 390 ) LEN . DATA 

0097 

390 

FORMAT(a.80Al) 

0098 

IF(LEN.LT.l)  GOTO  990 

0100 

NX-2 

0101 

MX-1 

0102 

NA-1 

0103 

CALL  FREEFM(NX,MX.NA,2) 

0104 

IF(REALX(1).NE.BLNK4)  G-REALX(l) 

0106 

IF(REALX(2) .NE.BLNK4)  EPS-REALX(2) 

0108 

GOTO  411 
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C 

C 

C  PERFORM  GAIN  SHIFT 

C 

0109  400  G =80/91 

0110  EPS=(A0-An/Bl 

0111  WRITE (CRT, 410)  G,EPS 

0112  410  FORMATi:iH0. 'RESULTING  GAIN  AND  ZERO  SHIFT  ARE: '/2G 12. 4/) 

0113  411  MF-1 

0114  MR-NCH 

0115  CALL  REGAINCR.S.G.EPS.MR.hF.NCH) 

0116  CALL  RECHAN<R,S.MR.MF.NCH) 

D  URITE(I0UT.412)(R(n.I  =  l.NCH) 

D412  FORMATCIX. 10G12.3) 

D  IJR1TE(I0UT.414> 

D414  FORMAT(lHl) 

0117  l*RITE(CRT,420) 

0118  420  FORMAT( IX. 'FILENAME  FOR  OUTPUT  SPECTRUM'/) 

0119  READ(CRT.430)LEN.ASC 

0120  430  FORMAT(Q.80Arji 

0121  IF(LEN.LT.  1)  GOTO  990 

0123  DO  440  1-1,32 

0124  TITLE(I)»DUMT(I) 

0125  440  CONTINUE 

0126  DO  445  I-l.a 

0127  ID(I)-DUMID(I) 

0128  445  CONTINUE 

0129  ELTIME-IDELT 

0130  PLTIME-IDPLT 

0131  ERTIME-IDERT 

0132  PRTIME-IDPRT 

0133  CALL  PUTCASC.R.IVAR.LUF.NCH.Al.Bl.Cl) 

C 

0134  990  STOP 

0135  END 
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NAME 

OFFSET 

ATTRIBUTES 

S 

000006 

REAL=K4 

ARRAY  (256) 

R 

002006 

REAL>X4 

ARRAY  (256) 

DUMT 

004006 

INTEGER*2 

ARRAY  (32) 

DUMID 

004106 

INTEGER>k2 

ARRAY  (8) 

AHEAD 

004126 

REAL>t<8 

ARRAY  (10) 

ASC 

004246 

LOGICAL*! 

ARRAY  (60) 

CRT 

004342 

INTEGER*2 

VARIABLE 

PERIOD 

004352 

INTEGER*2‘  VARIABLE 

BLANK 

004354 

INTEGER*2 

VARIABLE 

A6LANK 

004364 

REAL*a 

VARIABLE 

YES 

004374 

LOGICAL*! 

VARIABLE 

LP 

004344 

INTEGER*2 

VARIABLE 

IN 

004346 

INTEGER*2 

VARIABLE 

lOUT 

004350 

INTEGER*2 

VARIABLE 

LUF 

004356 

INTEGER*2 

VARIABLE 

BLNK4 

004360 

REAL*4 

VARIABLE 

LEN 

005424 

INTEGER*2 

VARIABLE 

NCH 

005426 

INTEGER*2 

VARIABLE 

GET 

000000 

REAL*4 

PROCEDURE 

I  VAR 

005430 

INTEGER*2 

VARIABLE 

A0 

005432 

REAL*4 

VARIABLE 

B0 

005436 

REAL*4 

VARIABLE 

C0 

005442 

REAL*4 

VARIABLE 

NX 

005446 

INTEGER*2 

VARIABLE 

MX 

005450 

INTEGER*2 

VARIABLE 

NA 

005452 

INTEGER*2 

VARIABLE 

FREEFM 

000000 

REAL*4 

PROCEDURE 

I 

005454 

INTEGER*2 

VARIABLE 

IDELT 

005456 

INTEGER*2 

VARIABLE 

IDPLT 

005460 

INTEGER*2 

VARIABLE 

IDERT 

005462 

INTEGER*2 

VARIABLE 

IDPRT 

005464 

INTEGER*2 

VARIABLE 

KUF 

005466 

INTEGER*2 

VARIABLE 

MCH 

005470 

INTEGER*2 

VARIABLE 

JVAR 

005472 

INTEGER*2 

VARIABLE 

A1 

005474 

REAL*4 

VARIABLE 

B1 

005500 

REAL*4 

VARIABLE 

Cl 

005504 

REAL*4 

VARIABLE 

G 

005510 

REAL*4 

VARIABLE 

EPS 

005514 

REAL*4 

VARIABLE 

MF 

005520 

INTEGER*2 

VARIABLE 

MR 

005522 

INTEGER*2 

VARIABLE 

REGAIN 

000000 

REAL*4 

PROCEDURE 

RECHAN 

000000 

REAL*4 

PROCEDURE 

PUT 

000000 

REAL*4 

PROCEDURE 

COMMON  BLOCK  /DATA/  LENGTH  000240 


COMMON  BLOCK  /FREE/  LENGTH  000340 

INTEG  000000  IHTEGER*2  ARRAY  (16) 
REALX  000040  REAL>K4  ARRAY  (16) 
ALPHA  000140  REALMS  ARRAY  (16) 


DATA 


000000  INTEGER*2  ARRAY  (80) 
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COMMON  BLOCK  /HEAD/  LENGTH  000142 


IHDR 

000000 

INTEGER>t‘2 

VARIABLE 

TITLE 

000002 

INTEGER>t<2 

ARRAY  (32) 

ID 

000102 

INTEGER*2 

ARRAY  (8) 

ELTIME 

000122 

REAL>«4 

VARIABLE 

PLTir€ 

000126 

REAL«4 

VARIABLE 

ERTIME 

000132 

REAL«4 

VARIABLE 

PRTIME 

000136 

REAL«4 

VARIABLE 

AL«4 

PROCEDURE 

A 

000134 

REAL«4 

VARIABLE 

MIN0 

000000 

INTEGER*2 

PROCEDURE 

A1 

000140 

REAL*4 

VARIABLE 

Also 

000144 

REAL*4 

VARIABLE 

B 

000150 

REAL*4 

VARIABLE 

AHALF 

000154 

REAL>K4 

VARIABLE 

AO 

000160 

REAL>K4 

VARIABLE 

s  s 
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SUBROUTINE  REGA I N ( R . S , G , EPS . MR . MF . NCH ) 

URITTEN  BY  G.U.  PHILLIPS 

NAVAL  RESEARCH  LABORATORY 

LAST  REVISED  AUGUST  1981  BY  G.U.P. 

PERFORMS  DIGITAL  GAIN  AND  2ERO  SHIFT 
ON  SPECTRAL  DATA 

DIMENSION  R(l).SCl) 

THE  EFFECT  OF  THIS  SUBROUTINE  IS  TO  FIRST  ADJUST  THE 
GAIN  BY  G.  AND  THEN  TO  SHIFT  THE  DATA  BY  EPS 

R-INITIAL  DATA  ARRAY,  S-SHIFTED  DATA  ARRAY 

G=GAIN  SHIFT.  EPS-2ER0  SHIFT.  MF-OFFSET  FOR  CHANNEL  1 

MR-NUMBER  OF  DATA  CHANNELS.  NCH-MAXIMUM  NUMBER  OF  CHANNELS 


0003 

IF(G.NE. 1.0.OR.EPS.NE 

0005 

DO  50  J»1.NCH 

0006 

50 

S(J)-R(J) 

0007 

P 

RETURN 

0008 

100 

DO  110  J-l.NCH 

0009 

110 

S(J)«>0. 

0010 

MI-MF-1 

0011 

AT=G*(MR+Mn+EPS 

0012 

MT-INT(AT) 

0013 

MT»MIN0(MT.NCH) 

0014 

MRI»MR 

0015 

MJ-INT(G*MI+£PS) 

0016 

MJ-MAX0(MJ.0) 

0017 

MF-MJ+1 

0018 

MR-MT-MJ 

0019 

GINV-l./G 

0020 

IF(G.GT.n  GO  TO  300 

MIDrtS 
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r- 

c 

c 

p 

DISTRIBUTE  COUNTS  (REBIN) 

0022 

L 

DO  200  I-UMRI 

0022 

A=G*(I+MI)+EPS 

0024 

IF(A.LT.0)  GOTO  200 

0026 

J»INT(A) 

0027 

DJ=*A-J 

0028 

J-J-MJ 

0029 

IF(J.LT.0.OR.J.GT.MR)  GOTO  200 

0031 

IF(DJ.LT.G)  GO  TO  160 

0033 

IF(J.LT.MR)  S(J+1)-S(J+1)+R(I) 

0035 

GOTO  200 

0036 

160 

DR-DJ*GINV*R(I) 

0037 

IF(J.LT.MR)  S(J+1)-S(J+1)+DR 

0039 

IF(J.GT.0)  S(J)-S(J)+R(I)-DR 

0041 

200 

CONTINUE 

0042 

JM-J+l 

0043 

p 

DJM-DJ 

L 

c 

p 

EXTRAPOLATE  ENDS 

0044 

L 

A0-G*MI+EPS 

0045 

IF(A0.LE.0)  GOTO  240 

0047 

J=INT(A0) 

0048 

DJ-A0-J 

0049 

J»J-MJ 

0050 

IFCJ.LT.O)  GOTO  240 

0052 

S  ( J*  1 ) -S  ( J+ 1 ) +D J#G  I  NV>t<R  ( I ) 

0053 

IFCjf.LT.  l)  GOTO  240 

0055 

J0-J 

0056 

DO  220  J-1.J0 

0057 

220 

p 

S(J)>GINV*R<1) 

0058 

240 

IF(JM.GT.MR)  RETURN 

0060 

S ( JM) -S ( JM) +( 1 -D JM) INV*R (MR  I ) 

0061 

JM-JM+1 

0062 

IF(JM.GT.MR)  RETURN 

0064 

DO  260  .J-JM,MR 

0065 

260 

S(J)-GINV*R(MRI) 

0066 

RETURN 
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C 

C 

C  INTERPOLATE  BETWEEN  MIDPOINTS 
C 


0067 

300 

DO  400  J-1,MR 

0068 

A»FLOAT(J+MJ)-0.5 

0069 

I-INTctA-EPSl^GINV) 

0070 

B=G*(I-0.5)+EPS 

0071 

I-I-MI 

0072 

IF(A-B.LE.G)  GOTO  340 

0074 

I^I  +  l 

0075 

B-B+G 

0076 

340 

IF(I.GT.0)  GOTO  350 

0078 

S(J)»R(U5KGINV 

0079 

GOTO  400 

0080 

350 

IFCI.LT.MRI)  goto  360 

0082 

S(J)-R(MRn»<GINV 

0083 

GOTO  400 

0084 

360 

DG-(A-B)*GINV 

0085 

S ( J) -DG>KR ( I +  1 ) #G INV+(  1 . -DG) *R ( I) *G INV 

0086 

400 

CONTINUE 
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NAME 

OFFSET 

ATTRIBUTES 

R 

000014 

REAL>K4 

PARAMETER 

ARRAY  (1) 

S 

000016 

REAL*4 

PARAMETER 

ARRAY  (1) 

G 

000020 

REAL>«4 

PARAMETER 

VARIABLE 

EPS 

000022 

REAL>M 

PARAMETER 

TRIABLE 

MR 

000024 

INTEGER*2 

PARAMETER 

VARIABLE 

MF' 

000026 

INTEGER»2 

PARAMETER 

VARIABLE 

NCH 

000030 

INTEGER*2 

PARAMETER 

VARIABLE 

J 

000034 

INTEGER*2 

VARIABLE 

MI 

000036 

INTEGER>K2 

VARIABLE 

AT 

000040 

REAL-1'4 

VARIABLE 

MT 

000044 

INTEGEP’t'2 

VARIABLE 

INT 

000000 

INTEGER'^2 

PFOCEPUPE 

MIN0 

000000 

INTEGER>x2 

PROCEDURE 

MRI 

000046 

INTESER*2 

VARIABLE 

MJ 

000050 

INTEGEPi‘2 

VARIABLE 

MAX0 

000000 

INTEGER^-:? 

PROCEDURE 

GINV 

000052 

REAL*4 

VARIABLE 

I 

000056 

INTEG2'?*2 

vAR  (ABLE 

A 

000060 

REAL-'K-'i 

VPR lABLE 

DJ 

000064 

REAL>4 

VAF  TABLE 

DR 

000070 

REAL=i‘4 

VAR i ABLE 

JM 

000074 

INTEGER-K2 

VARIABLE 

DJM 

000076 

REAL-^4 

VARIABLE 

A0 

000102 

REAL*4 

VARIABLE 

J0 

000106 

lN-rFC,':R:t!2 

VARIABLE 

FLOAT 

000000 

RcAi.:k4 

PROCEPUPE 

B 

0001 10 

REAL«4 

VARIABLE 

mr 

000114 

REAL«4 

VARIABLE 
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0001 

C 

P 

SUBROUTINE  RECHANCR.S.MR.MF.NCH) 

URITTEN  BY  G.U. PHILLIPS.  AUGUST  1981 

u 

c 

SHIFTS  DATA  IN  ARRAY  S  BY  MF-1  CHANNELS 

c 

AND  STORES  THE  SHIFTED  DATA  IN  ARRAY  R 

0002 

r 

DIMENSION  R(2561.S(2565 

0003 

u 

100 

K-MF-1 

0004 

MF-1 

0005 

MR-MR+K 

0006 

IF(MF  LT.0)  MR-0 

0008 

IF(MR.GT.NCH)  MR-NCH 

0010 

J»1 

0011 

IF(K.LT.l)  GOTO  120 

0013 

J-K+1 

0014 

DO  110  I-1,K 

0015 

110 

R(n-0. 

0016 

120 

DO  130  I-J,MR 

0017 

130 

R(n-S(I-K) 

0018 

L-MR+1 

0019 

IF(L.GT.NCH)  RETURN 

0021 

DO  140  I-L,NCH 

0022 

140 

R(I)-0. 

0023 

RETURN 
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NAME 

OFFSET 

ATTRIBUTES 

R 

900014 

REAL«4 

FARAMBTER 

ARRAY  (2561 

S 

000016 

REAL*4 

PARAMETER 

ARRAY  (256) 

rt? 

000920 

INTEGERxia 

PARAMETER 

VARIABLE 

rr 

000022 

INTEGERwa 

PARAMETER 

VARIABLE 

NCH 

000024 

INTEGER>«2 

PARAMETER 

VARIABLE 

K 

000026 

INTEGER*2 

VARIABLE 

J 

000030 

INTEGER*2 

VARIABLE 

I 

000032 

INTEGER*2 

VARIABLE 

L 

000034 

INTEGER»2 

VARIABLE 
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C 

C 

C 

C  COPYRIGHT  (C)  1977  BY  NUCLEAR  DATA  INCORPORATED 

C  SCHAUMBURG.  ILLINOIS  60196 

C 
C 

C  THIS  DOCUI^NTATION  IS  FURNISHED  INCLUDING  THE  COPYRIGHT 

C  NUCLEAR  DATA  INCORPORATED.  IT  MUST  NOT  BE  REMOVED  AND  MAY  NOT 

C  BE  REPRODUCED  OR  REDISTRIBUTED  WITHOUT  THE  WRITTEN  EXPLICIT 

C  PERMISSION  OF  NUCLEAR  DATA. 

C 

C  WHEREBY  NUCLEAR  DATA  CORPORATION  ASSUMES  THE  SUPPORT 

C  RESPONSIBILITIES  WHEN  PROPERLY  APPLIED  TO  ND6600  (MIDAS) 

C  SYSTEMS. 

C 

C  NUCLEAR  DATA  CORPORATION  ASSUMES  NO  RESPONSIBILITY  FOR  USE 

C  OF  AFORMENTIONED  SOFTWARE  IN  EQUIPMENT  EXCLUDED  FROM  THE 

C  ND6600-SERIES  EQU I Pr«NT  SUPPLIED  BY  NUCLEAR  DATA  INCORPORATED, 

r 

C  SEDIT  MOD  44-0436-01  10  MAR  77  L. HOLMES 

C  THIS  IS  THE  PREGA  LIBRARY  FILE  EDITOR 

C  IT  BUILDS  A  LIST  OF  THE  STANDARD  ISOTOPE  SPECTRA 
C  TO  BE  USED  FROM  THE  DISK 

C 
C 

C  FILE  STRUCTURE 

C 

C  RECORD  :  PARAMETER 
C 

C  1  NUMBER  OF  STANDARDS  IN  LIBRARY 

C  2  NUMBER  OF  CHANNELS  PER  STANDARD 

C  3  NUMBER  OF  ITERATIONS  FOR  GAIN  THRESHOLD  SHIFT 
C  4  BACKGROUND  SUBTRACT  ? 

C  5  INITIAL  CHANNEL  FOR  COMPUTATION 

C  6  FINAL  CHANNEL  FOR  COMPUTATION 

C  7-39  SPACE  RESERVED  FOR  FILE  E>a’ANSION 
C  40  COUNTING  TIME  FOR  BACKGROUND 

C  41  REJECTION  COEFFICIENT. 

C  42-49  ID  FOR  LIBRARY  BACKGROUND 

C  50-64  SPACE  RESERVED  FOR  FILE  EXPANSION 
C 
C 

C  65-96,97-120 _  LIST  OF  STANDARDS  WITH  ASSOCIATED  PARAMETERS 

C  I.E. 

C 

C  RECORD  :  PARAMETER 
C 

C  EIBHT  CHARACTER-  NAME  OF*STANDARD 

C  6^73  FILE. ELEMENT  ID 

C  74  HALF-LIFE 

C  75  COUNTING  TIME  OF  SAMPLE 


C  76  ACTIVITY  OF  SAMPLE 

C 

C 

eeei  integer  ans.yes 

0002  DATA  YES.NO/IHY. IHN/ 
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0003 

0004 

0005 

0006 

0007 

0008 

9009 

0010 

0011 

9012 

9013 
0014 
9015 
0016 

9017 

9018 
0019 
0020 
9021 
0022 
0023 
0024 
0025 
0026 
0027 
0028 
0029 
0030 
0031 
0033 
0035 
0037 
0039 
0040 
0041 
9042 
0043 
9044 
0046 
0048 
9059 
0051 
0052 
0053 
0054 
0055 

0056 

0057 

0059 

0061 

0062 

0063 

0064 

0065 

0066 


INTEGER  INT(2G).MLI(40) 

LOGICAL*!  A (32) 

DATA  LN/IMN/ 

DATA  LI.LD,LA,LP/1HI. IHD. IHA. IHL/ 

INTEGER  88. CC 
DATA  BB.CC/IHB.IHC/ 

INTEGER  BS.BT.RC.BA 
DATA  NC.  IT.BS. IS. lE.LL.LS.BT.RC.BA 
1 /2HNC . 2H I T. 2HBS . 2H I S . 2H IE . 2HLL . 2HLS . 2HBT. 2HRC . 2HBA/' 

INTEGER  Y.D.H 

DATA  Y.D.H.MM/IHY. IHD.IHH.IHM/ 

INTEGER  EDT 

EDT-0 

L-5 

N-0 

LUN-9 

LUI-11 

DO  1200  1-1.40 
1200  rt.I(I)-I 

DEFINE  FILE  LUN(4096.2.U. IVAR) 

DEFINE  FILE  LUI (4096.2.U. IVAR) 

IVAR-1 

READ(LUN' 1. END-500. ERR-600)M 
URITECS. 1) 

1  FORMAT ( IX. 'PREGA  LIBRARY  FILE  EDITOR'./) 

10000  CONTINUE 

1999  WRITE (5, 2000) 

2000  FORMATC IX. 'HEADER:  BUILD(B).  CHANGE(C).  LIST(L)  '.*) 

RE  AD  <  5 . 5000 )  LENGTN .  ANS 

IF(LENGTH.LE.0)GO  TO  15 
IF(ANS.EQ.BB)GO  TO  2001 
IFCANS.EQ.COGO  TO  2500 
IF(ANS.Ea.LP)GO  TO  6500 
GO  TO  10000 

2001  ASSIGN  2050  TO  K 

2040  WRITE (5. 2041) 

2041  FORMATC'  '.'(NO  NUMBER  OF  CHANNELS  PER  STANDARD  (MAX-512)  '.$) 

2042  READ(5.5001)LENGTH.FNUM 

IF (LENGTH. LE.0) GO  TO  10000 
IF (FNUM. GT. 5 12 . ) FNUM-5 12 . 

IFCFNUM.LE. 1.0)FNUM-1.0 
NUM-FNUM 
WRITE(LUN'2)NUM 
GO  TO  K 

2050  ASSIGN  2060  TO  K 
WRITE (5. 2051) 

2051  FORMATC'  '.'(IT)  NUMBER  OF  ITERATIONS  FOR  THRESHOLD  8.  GAIN  CALC 
1  '.$) 

2052  READ (5. 5001) LENGTH. FNUM 
IF(LENGTH.LE.0)GO  TO  10000 
IFCFNUM.LE. 1.0)FNUM-1.0 
NUM-FNUM 
WRITE(LUN'3)NUM 

GO  TO  K 

2060  ASSIGN  2070  TO  K 
WRITE(5.2061) 

2061  FORMATC'  '.'(BS)  BACKGROUND  SUBTRACT  ?  '.$) 
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0067 

2062 

RE AD ( 5 . 5000 ) LENGTH , ANS 

0068 

IF(LENGTH.LE.0)GO  TO  10000 

0070 

NUM-0 

0071 

IF(ANS.EQ.YES)NUM='l 

0073 

IJRITE(LUN'4)NUM 

0074 

GO  TO  K 

0075 

2070 

ASSIGN  2080  TO  K 

0076 

IJRITE(5.2071) 

0077 

2071 

FORNATC’  '.'(IS)  INITIAL  CHANNEL  FOR  COMPUTATION  '.$) 

0078 

2072 

READ ( 5 . 500 1 ) LENGTH . FNUM 

0079 

IF (LENGTH. LE.0) GO  TO  10000 

0081 

IF(FNUM.GT.512. )FNUM-512. 

0083 

IF(FNUM.LE. 1.0)FNUM-1.0 

0085 

NUM-FNUM 

0086 

URITE(LUN'5)NUM 

0087 

GO  TO  K 

0088 

2080 

ASSIGN  2110  TO  K 

0089 

lJRITE(5.20ai) 

0090 

2081 

FORMAT ('  '.'(IE)  FINAL  CHANNEL  FOR  COMPUTATION  '.$) 

0091 

2082 

READ (5.5001) LENGTH . FNUM 

0092 

IF (LENGTH. LE.0) GO  TO  10000 

0094 

IF (FNUM. GT. 5 12 . ) FNUM-5 12 . 

0096 

IF(FNUM.LE. 1.0)FNUM-1.0 

0098 

NUM-FNUM 

0099 

IJRITE(LUN'6)NUM 

0100 

GO  TO  K 

0101 

2110 

ASSIGN  2120  TO  K 

0102 

IJRITE(5.2111) 

0103 

2111 

FORMAT('  '.'(8T)  COUNTING  TIME  OF  BACKGROUND  (SECS.)  '.$) 

0104 

2112 

RE AD ( 5 . 500 1 ) LENGTH . FNUM 

0105 

IF (LENGTH. LE.0) GO  TO  10000 

0107 

IF (FNUM. LE. 1.0) FNUM- 1.0 

0109 

IJRITE(LUN'40)FNUM 

0110 

GO  TO  K 

0111 

2120 

ASSIGN  2130  TO  K 

0112 

UIRITE(5,2121) 

0113 

2121 

FORMAT('  '.'(RC)  REJECTION  COEFICIENT  ',$) 

0114 

2122 

READ ( 5 . 500 1 ) LENGTH . FNUM 

0115 

IF (LENGTH. LE.0) GO  TO  10000 

0117 

URITE(LUN'41)FNUM 

0118 

GO  TO  K 

0119 

2130 

ASSIGN  ?140  TO  K 

0120 

WRITE (5, 2 131) 

0121 

2131 

FORMAT ('  '.'(BA)  BACKGROUND  SPECTRUM  ( FILE.ELEMENT(. DEVICE) : 

0122 

2132 

READ (5.4) LENGTH, ( A ( I ) , I - 1 , 32) 

0123 

IF(LENGTH.LE.0)GO  TO  10000 

0125 

I VAR -42 

0126 

DO  2133  1-1.32.4 

0127 

2133 

(JRITE(LUN' IVAR)A(I).A(I+l).A(I+2).A(I+3) 

0128 

GO  TO  K 

0129 

2140 

GO  TO  1999 

0130 

2500 

ASSIGN  2500  TO  K 

0131 

URITE(5.2501) 

0132 

2501 

FORMAT('  '.'WHICH  PARAMETER  DO  YOU  WISH  TO  MODIFY  ?  ',$) 

0133 

READ ( 5 . 5007 ) LENGTH . ANS 

0134 

IF (LENGTH. LE.0) GO  TO  10000 

0136 

IF(ANS.EQ.NC)GO  TO  6000 
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0138 

IF(ANS.EQ.IT)GO  TO  6001 

0140 

IF(ANS.EQ.BS)GO  TO  6002 

0142 

IF(ANS.EQ.IS)GO  TO  6003 

0144 

IF  CANS. EQ. IE) GO  TO  6004 

0146 

IF(ANS.EQ.BT)GO  TO  6007 

0148 

IFCANS.EQ.ROGO  TO  6008 

0150 

IF(ANS.EQ.BA)GO  TO  6009 

0152 

GO  TO  2500 

0153 

6000 

READ(LUN'2)NUM 

0154 

IJRITE(L.2041) 

0155 

IJRITE(L.5004)NUM 

0156 

IF(EDT.EQ.1)G0  TO  7000 

0158 

GO  TO  2042 

0159 

6001 

READ(LUN'3)NUM 

0160 

LJRITE(L.2051) 

0161 

IJRITE(L.5004)NUM 

0162 

IFCEDT.EQ.DGO  TO  7000 

0164 

GO  TO  2052 

0165 

6002 

READ(LUN'4)NUM 

0166 

URITE(L.2061) 

0167 

ANS-NO 

0168 

IFCNUM.EQ.  DANS-YES 

0170 

URITE(L,5008)ANS 

0171 

IFCEDT.EQ. 1)G0  TO  7000 

0173 

GO  TO  2062 

0174 

6003 

READ(LUN'5)NUM 

0175 

URITE(L.2071) 

0176 

LJRITE(L,5004)NUM 

0177 

IF(EDT.EQ.  DGO  TO  7000 

0179 

GO  TO  2072 

0130 

6004 

READ(LUN'6)NUM 

0181 

IJRITE(L.2081) 

0182 

IJRITE(L,5004)NUM 

0183 

IFCEDT.EQ.  DGO  TO  7000 

0185 

GO  TO  2082 

0186 

6007 

READ(LUN'40)FNUM 

0187 

URITE(L.211D 

0188 

IJ?ITE(L.5005)FNUM 

0189 

IFCEDT.EQ.  DGO  TO  7000 

0191 

GO  TO  2112 

0192 

6008 

READCLUN'4DFNUM 

0193 

tJRITECL.2l2D 

0194 

WRITE  CL. 5005) FNUM 

0195 

IFCEDT.EQ.  DGO  TO  7000 

0197 

GO  TO  2122 

0198 

6009 

I VAR -42 

0199 

DO  2600  1-1,32,4 

0200 

2600 

READCLUN'  IVAR)AC  D.ACI+D.ACI+2).ACI+3) 

0201 

URITECL,213D 

0202 

WRITE  CL,  5006)  CACD, 1-1.32) 

0203 

IFCEDT.EQ.  DGO  TO  7000 

0205 

GO  TO  2132 

C  HEADER  LISTER 

0206 

6500 

CONTINUE 

0207 

L-6 

0208 

EDT-1 

0209 

WRITECL.650D 
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0210 

6501 

0211 

0212 

7000 

0213 

0215 

0216 

6010 

0217 

0218 

0219 

0220 

0221 

3000 

0222 

15 

0223 

0224 

16 

0225 

0226 

111 

0227 

0228 

0229 

0230 

0231 

2 

0232 

0234 

0236 

0238 

0240 

0242 

0244 

0245 

25 

0246 

0247 

0248 

20 

0249 

0250 

21 

0251 

0253 

0254 

22 

0255 

0256 

3 

0257 

0258 

4 

0259 

0261 

0262 

10 

0263 

0264 

5 

0265 

0266 

6 

0267 

0269 

0271 

0273 

0275 

0277 

0278 

0279 

7 

0280 

FORMAT ('1'.'  PREGA  LIBRARY  HEADER'./-/) 

1-0 

I-I+l 

IFd.GT.  a)GO  TO  6010 

GO  TO  (6000,6001.6002.6003.6004.  6007.6008.6009)  .! 

L-5 

EDT-0 

URITE(6.411) 

IJRITE(6.411) 

GO  TO  1999 
CONTINUE 
CONTINUE 
URITE(5.16) 

FORMATdX.'LIST  OF  STANDARDS') 
liJRITE(5.  Ill) 

FORMATC IX. 'NEU  FILE(N) . INSERTC I) .DELETE (D) .APPEND (A) ,LIST(L) 

IVAR-1 

N-0 

EDT-0 

READ (5. 2) LENGTH. ANS 
FORMAT(Q.Al) 

IF (LENGTH. EQ.0) GO  TO  1000 
IF(ANS.EQ.LN)GO  TO  25 
IF(ANS.EQ.LI)GO  TO  100 
IF(ANS.EQ.LD)GO  TO  200 
IF ( ANS. EQ. LA) GO  TO  300 
IF(ANS.Ea.LP)GO  TO  400 
GO  TO  15 
CONTINUE 
IVAR-65+N*16 
URITE(5.20) 

FORMAT( IX. 'ISOTOPE  NAME  (8  CHARACHTERS  MAX)  '.S) 
READ(5,21)LENGTH.  (Ad),  1-1.8) 

F0RMAT(a.8Al) 

IF (LENGTH. EQ.0) GO  TO  15 
DO  22  1-1.8. 4 

URITE(LUN'  IVAR)Ad),A(I+l).A(I+2),A(I+3) 

URITE(5.3) 

FORMAT( IX. ' F ILE . ELEMENT( . DEVICE)  ' ,*) 

READ (5. 4) LENGTH. ( A ( I ) . I - 1 . 32) 

F0RMAT(a,32Al) 

IF (LENGTH. Ea.0) GO  TO  15 
DO  10  1-1.32.4 

URITE(LUN'IVAR. END-500. ERR-600)A( I). A(I+1),A( 1+2). A( 1+3) 
IJRITE(5.5) 

FORMAT( IX. 'HALF-LIFE. UNITS(Y.D.H.M.S)  ' .$) 

READ(5,S)LENGTH,HL.K 

FORMAT(Q.E12.0. lAl) 

IF(LENGTH.Ea.0)GO  TO  15 
I F ( K . EQ . Y) HL -HL#3 1 536000 . 

IF(K.EQ.D)HL-HL>K86400. 

IF(K.Ea.H)HL-HL)K3600. 

IF(K.EQ.MM)HL-HL*60. 

IJRITE(LUN'IVAR)HL 

LJRITE(5,7) 

FORMAT (IX. 'COUNTING  TIME  OF  STANDARD  (SECS.)  ',$) 

READ ( 5 , 500 1 ) LENGTH . SEC 
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0281 

IF (LENGTH. EQ.0) GO  TO  15 

0283 

IF(SEC.LE. 1.0)SEC-1.0 

0285 

URITECLUN' IVARJSEC 

9> 

0286 

URITE(5.9) 

0287 

9 

FORMATC IX. 'ACTIVITY  (MAY  BE  SET  TO  1)  ',$) 

0288 

READ (5.5001) LENGTH . ACT 

•'"J 

0289 

IF (LENGTH. EQ.0) GO  TO  15 

0291 

IJRITE(LUN'  IVARIACT 

0292 

IF(EDT.EQ.  DGO  TO  15 

0294 

N-N+1 

pi 

0295 

M-N 

0296 

URITE(LUN'  DM 

V. 

0297 

GO  TO  25 

0298 

100 

URITE(5. 101) 

0299 

101 

FORMAT( IX. 'NUMBER  OF  ENTRY  TO  BE  INSERTED  '.$) 

0300 

READ(5. 102)FNUM 

0301 

102 

FORMAT(F10.0) 

w  • 

0302 

NUM-FNUM 

0303 

N-M 

0304 

IF(N.LT.NUM)GO  TO  15 

.. 

0306 

M-M+1 

0307 

N-M 

0308 

EDT-1 

0309 

103 

IF(N.LT.NUM)GO  TO  25 

•  • 

0311 

IVAR-65+(N-l)*16 

_ 

0312 

DO  104  1-1.26.2 

%  , 

0313 

104 

READ(LUN' IVAR) INT( I) , INT( I+l) 

0314 

IVAR-IVAR+3 

0315 

DO  105  1-1.26,2 

*  — 

0316 

105 

URITE(LUN' IVAR) INT( I) . INT( I+l) 

W: 

0317 

N-N-1 

.  m 

mt  1 

0318 

P 

GO  TO  103 

S: 

0319 

200 

IJRITE(5.201) 

0320 

201 

FORMAT( IX. 'NUMBER  OF  ENTRY  TO  BE  DELETED  '.$) 

0321 

READ(5.202)FNUM 

. 

0322 

202 

FORMAT(FI0.0) 

0323 

NUM-FNUM 

0324 

IF(NUM.GT.M)GO  TO  15 

0326 

IF(NUM.EQ.M)GO  TO  206 

0328 

IF(M.LE.0)GO  TO  206 

V 

0330 

203 

CONTINUE 

0331 

I VAR -NUM* 16+65 

■ri 

0332 

DO  204  1-1.26.2 

0333 

204 

READ(LUN' I VAR. END -500. ERR -600) INT( I ) . INT( I+l) 

• .  ^ 

0334 

IVAR- I VAR-29 

■.1 

0335 

DO  205  1-1.26.2 

0336 

205 

(JRITE(LUN' IVAR. END-500. ERR-600)  INT( I) , INT( I+l) 

0337 

NUM-NUM+1 

>: 

0338 

IF(NUM.LT.M)GO  TO  203 

0340 

206 

CONTINUE 

0341 

M-M-1 

0342 

GO  TO  15 

Cv 

0343 

300 

N-M 

0344 

GO  TO  25 

V*; 

0345 

400 

IF(M.EQ.0)GO  TO  15 

mi 

i 


v*''- 
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0347 

1008 

LJRITE(S,1010) 

.  ♦  , 

0348 

1010 

FORMATC'  '.'DO  YOU  UISH  TO  PRINT  FULL  STANDARD  LIST?',$) 

’ ,« 

0349 

READ (5, 2) LENGTH. ANS 

0350 

IF (LENGTH. LE.0)  GO  TO  1008 

0352 

IF(ANS.EQ.YES)GO  TO  1020 

I* 

0354 

READCLUI'29)  MLA 

D 

IJRITEC6.7100)  MLA 

-> 

D7100 

FORMATC'  '.'  MLA«'.I6) 

• 

D 

URITE(5,7105) 

D7105 

FORMATC'  '.'  IVAR-?'.$) 

D 

READ C5. 7 106)  IVAR 

D7106 

FORMATC 12) 

0355 

I  VAR  =*44 

0356 

DO  1014  I-l.MLA 

-■  ; 

0357 

READCLUI' IVAR)  MLKI) 

D 

LJRITE(6.7110)  IVAR.  I. MLKI) 

D7110 

FORMATC'  '.'  IVAR-*. 13.'  MLI (' . 12. ' ) -' . 16) 

w 

0358 

1014  CONTINUE 

0359 

URITE(6, 1016) 

0360 

1016 

FORMAT (' r . '  PREGA  L I BRARY  STANDARDS  USED ' . //) 

«  «  • 

0361 

GO  TO  1024 

•  •  ’ 

0362 

1020 

MLA-M 

D 

IJRITEC6,7120)  MLA 

D7120 

FORMATC'  '.'  MLA-M-'. 14) 

0363 

URITE(6.401) 

0364 

401 

FORMATC' 1'.'  PREGA  LIBRARY  STANDARDS'.//) 

-'S' 

0365 

1024 

DO  1090  JI-l.MLA 

•> 

0366 

IVAR-65+16*(MLI(JI)-l) 

0367 

DO  415  1-1.8. 4 

s 

0368 

415 

READCLUN' IVAR)A( I) .AC I+l) .AC I+2).AC 1+3) 

■MV 

0369 

LRITE(6.425)MLI(JI).CA(I).I-1.8) 

IP 

037P 

425 

FORMATC  IX. 'STANDARD  #  '.12.'  :  '.BAD 

0371 

DO  404  1-1.32.4 

0372 

404 

READCLUN' IVAR) AC  I) .AC I  +  l) .AC  1+2) , AC  1+3) 

.-.s- 

0373 

liJRITE(6.3) 

0374 

IJRITE(6.405)  (A (I).  1-1.32) 

'.‘•V 

0375 

405 

FORMAT('+'.  ';  '.32A1) 

0376 

READCLUN' IVAR) SEC 

0377 

URITEC6.406)SEC 

*• 

0378 

406 

FORMATC IX. 'HALF-L IFE  (SECS) : ' . 1PE12. 4) 

0379 

READCLUN' IVAR)HL 

0380 

WRITE (6. 407) HL 

■ .  > 

• '.N 

0381 

407 

FORMATC IX. 'COUNTING  TIME  OF  STANDARD  (SECS) : ' . 1PE12.4) 

0382 

READCLUN' I VAR) ACT 

!V1 

0383 

WRITE (6. 408) ACT 

TT" 

0384 

408 

FORMATC IX. 'ACTIVITY: '. 1PE12. 4.//) 

0385 

1090 

r 

CONTINUE 

- 

0386 

410 

WRITE(6.411) 

0387 

WRITE(6.411) 

■’ 

0388 

WRITE(6.411) 

0389 

WRITE(6.411) 

0390 

WRITE(6,411) 

0391 

WRITE(6.411) 

'S' 

0392 

WRITEC6,411) 

0393 

WRITE(6.411) 

'Ks 

0394 

411 

FORMAT ('+'.' 

niDfts 
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0395 

GO  TO  15 

0396 

500 

URITE(5.501) 

0397 

501 

FORMATCIX, ‘FILE 

NOT  LARGE  ENOUGH') 

0398 

GO  TO  1000 

0399 

600 

URITE(5,60n 

0400 

601 

FORMATdX. 'FILE 

SET  UP  NOT  CORRECT') 

0401 

GO  TO  1000 

0402 

5008 

FORMflT(Q,Al) 

0403 

5001 

FORnAT(Q,E12.0) 

0404 

5003 

F0RMAT(Q.32An 

0405 

5004 

F0RI1AT('+'.';  ' 

.14./) 

0406 

5005 

FORMAT('+'.' :  ' 

.G12.6./) 

0407 

5006 

FORMATdX.' 

:  '.32A1./) 

0408 

5007 

F0RMAT(Q.A2) 

0409 

5008 

FORMATC ' 

.  lAl./) 

0410 

1000 

IF(M.GE.40)M-40 

0412 

URITECLUN'  DM 
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NAME 

OFFSET 

ATTRIBUTES 

INT 

000006 

INTEGER>K2 

ARRAY  (26) 

MLI 

000072 

INTEGER*2 

ARRAY  (40) 

A 

000212 

LOGICAL«l 

ARRAY  (32) 

ANS 

003000 

INTEGER>K2 

VARIABLE 

YES 

000252 

INTEGER*2 

VARIABLE 

SB 

000270 

INTEGER#2 

VARIABLE 

CC 

000272 

INTEGER*2 

VARIABLE 

BS 

000300 

INTEGER*2 

VARIABLE 

BT 

000312 

INTEGER*2 

VARIABLE 

RC 

000314 

INTEGER*2 

VARIABLE 

BA 

000316 

INTEGER#2 

VARIABLE 

Y 

000320 

INTEGER#2 

VARIABLE 

D 

000322 

INTEGER*2 

VARIABLE 

H 

000324 

INTEGER)t«2 

VARIABLE 

EDT 

003002 

INTEGER*2 

VARIABLE 

NO 

000254 

INTEGER*2 

VARIABLE 

LN 

000256 

INTEGER*2 

VARIABLE 

LI 

000260 

INTEGER*2 

VARIABLE 

LD 

000262 

INTEGER#2 

VARIABLE 

LA 

000264 

INTEGER*2 

VARIABLE 

LP 

000266 

INTEGER#2 

VARIABLE 

NC 

000274 

INTEGER>t<2 

VARIABLE 

IT 

000276 

INTEGER*2 

VARIABLE 

IS 

000302 

INTEGER*2 

VARIABLE 

IE 

000304 

INTEGER>t<2 

VARIABLE 

u.. 

000306 

INTEGER>t<2 

VARIABLE 

LS' 

000310 

INTEGER>K2 

VARIABLE 

MM 

000326 

INTE6ER*2 

VARIABLE 

L 

003004 

INTEGER*2 

VARIABLE 

N 

003006 

INTEGER#2 

VARIABLE 

LUN 

003010 

INTEGER*2 

VARIABLE 

LUI 

003012 

INTEGER*2 

VARIABLE 

I 

003014 

INTEGER*2 

VARIABLE 

I  VAR 

003016 

INTEGER»2 

VARIABLE 

M 

003020 

INTEGER't‘2 

VARIABLE 

LENGTH 

003022 

INTEGER*2 

VARIABLE 

K 

003024 

INTEGER*2 

VARIABLE 

FNUM 

003026 

REAL>K4 

VARIABLE 

NUM 

003032 

INTEGER*2 

VARIABLE 

HL 

003034 

REAL>k4 

VARIABLE 

SEC 

003040 

REAL«4 

VARIABLE 

ACT 

003044 

REAL«4 

VARIABLE 

MLA 

003050 

INTEGER*2 

VARIABLE 

JI 

003052 

INTEGER*2 

VARIABLE 
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MODIFIED  8  JUNE  1981  BY  G. PHILLIPS 

COPYRIGHT  (C)  1977  BY  NUCLEPR  DPTP  INCORPORPTED 
SCHPUMBURG,  ILLINOIS  60196 

THIS  DOCUMENTPTION  IS  FURNISHED  INCLUDING  THE  COPYRIGHT 
NUCLEPR  DPTP  INCORPORPTED.  IT  MUST  NOT  BE  REMOVED  PND  MPY  NOT 
BE  REPRODUCED  OR  REDISTRIBUTED  UITHOUT  THE  URITTEN  EXPLICIT 
PERMISSION  OF  NUCLEPR  DPTP. 

UIHEREBY  NUCLEPR  DPTP  CORPORPTION  PSSUMES  THE  SUPPORT 
RESPONSIBILITIES  UHEN  PROPERLY  PPPLIED  TO  ND6600  (MIDPS) 
SYSTEMS. 

NUCLEPR  DPTP  CORPORPTION  PSSUMES  NO  RESPONSIBILITY  FOR  USE 
OF  PFORMENTIONED  SOFTUPRE  IN  EQUIPMENT  EXCLUDED  FROM  THE 
ND6600-SERIES  EQUIPMENT  SUPPLIED  BY  NUCLEPR  DPTP  INCORPORPTED 

UEDIT  MOD  44-0435-01  10  MPR  77  L. HOLMES 

THIS  IS  THE  NPI  UNKNOWN  LIBRPRY  EDITOR. 

IT  SETS  UP  THE  PNPLYSIS  PPRPMETERS  FOR 
THE  UNKNOWN  SPMPLE  SPECTRUM. 


FILE  STRUCTURE 
RECORD  !  PPRPMETER 

1-8  ID  OF  SPMPLE 

10  GPIN  SHIFT  RPTIO 

11  THRESHOLD  SHIFT 

12  BPCKGROUND  SUPPLIED  ? 

13  BPCKGROUND  SUBTRPCT  ? 

14  COUNTING  TIME  FOR  BPCKGROUND 

15  COUNTING  TIME  FOR  UNKNOU>»  SPMPLE 

16  VOLUME  REDUCTION  FPCTOR 

17  DECPY  TIME 

18  RESULT  MULTIPLICPTION  FPCTOR 

19-27  ID  OF  SPMPLE  BPCKGROUND 

28  WEIGHTING  FPCTOR  DETERMINPTION 

29  NUMBER  OF  STPNDPRDS  USED 

30  F-TEST  REJECTION  COEFFICIENT 

31  WEIGHTING  FPCTOR  CPLCULPTION 

32  LIBRPRY  REJECTION  COEFFICIENT  PPPLIED  7 

THIS  REJECTION  COEFFICIENT  IS  IN  SEDIT. 

33  BPCKGROUND  REGRESSION? 

34  PIVOT  ON  BPCKGROUND? 

35  OUTPUT  RESIDUPLS? 

36-42  ID  OF  OUTPUT  FILE 
43,44,...  ORDER  OF  OUTPUT  FILE 
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0001 

0002 

0003 

0004 


0005 

0006 

0007 

0008 

0009 

0010 

0011 

0012 

0013 

0014 

0015 

0016 

0017 

0018 

0019 

0020 

0021 

0022 

0023 

0024 

0025 

0026 

0028 

0029 

0031 

0033 

0035 


C 

C 

INTEGER  CC 
INTEGER  EDT 

INTEGER  UN.OP.CB.BG.BS.0T.UT.VR.DT.MF.S0.LJD.NS.F0.tJF.RC.BR.BP.ANS, 
lYES  CRT  RO  RS 

DATA  LIN*OP’CB.BG.BS,BT.VR.DT,MF,SB,IJD,NS.F0.UF.RC,BR.BP.RO,RS 
1 /2HUN . 2H0P , 2HCB , 2HBG , 2HBS . 2HBT, 2HVR , 2HDT. 2HMF . 2HSB . 2HUD . 2HNS . 2HF0 . 
22HUF,2HRC,2HBR,2HBP,2HR0,2HRS/ 

INTEGER  GN.TH 

DATA  GN.TH/^HGN.2HTH/' 

INTEGER  OR 
DATA  0R/2HQR/ 

DATA  UT/^HUT/ 

DATA  NN.CC.LL.YES.NO/IHN. IHC. IHL. IHY. IHN/ 

INTEGER  CT 
DATA  CT/^HCT/ 

INTEGER  BA 
DATA  BA/^HBA/ 

LOGICAL*!  A(32) 

LUN-11 

DEFINE  FILE  LUN(4096,2.U.  IWR) 

CRT-5 

READCLUN'  DM 
UR  I TE (CRT.  1) 

1  FQRMATdX. 'PREGA  UNKNOUSH  FILE  EDITOR’ 

10000  CONTINUE 
1500  URITE(5.4) 

4  FQRMATdX.'NEU  FILE(N1.  CHANGE (C).  LIST(L)  ’.$) 

READCCRT. 1002) LENGTH, ANS 
IF (LENGTH. LE.0) GO  TO  11000 
I VAR -2 

IF(ANS.Ea.CC)GO  TO  450 
IF(ANS.Ea.LL)GO  TO  900 
IF(ANS.EQ.NN)GO  TO  49 
GO  TO  1500 


109 
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0036 
003? 
0038 
0039 
0040 
0041 
0043 
0044 
0045 
0046 
004? 
0048 
0049 
0050 
0052 
0054 
0055 
0056 
005? 
0058 
0059 
0060 
0062 
0063 
0064 
0065 
0066 
006? 
0068 
00?0 
00?  1 
0O?3 
00?4 
00?5 
00?6 
00?? 
00?8 
00?9 
0081 
0082 
0084 
0085 


C 

C  BUILD  INDIVIDUAL  FILES 

49  CONTINUE 
ASSIGN  60  TO  K 

50  lJRITE(CRT.5n 

51  FORMATdX,' (UN)  UNKNOWN  SPECTRUM:  FILE.  ELEMENT  (.DEV  ICE) 

52  READ (CRT. 1001 ILENGTH. (A( I) . 1-1.32) 

IF (LENGTH. LE.0) GO  TO  10000 

DO  55  1-1.32.4 

55  IJRITE(LUN*  WAR) A(  I) . A(  I+l ) . A(  1+2) .  A(  1+3) 

GO  TO  K 

60  ASSIGN  ?0  TO  K 
bJRITE(CRT.61) 

61  F0RMAT(1X.*(GN)  GAIN  SHIFT  RATIO  ’.$) 

62  READ ( CRT. 1 003 ) LENGTH . FNUM 
IF(LENGTH.LE.0)GO  TO  10000 
IF(FNUM.LE. (1.0E-5)) FNUM- 1.0 
LJRITE(LUN'  WAR) FNUM 

GO  TO  K 

?0  ASSIGN  80  TO  K 

IJ?ITE(CRT.?1) 

?1  FORMAT ( IX. *(TH)  THRESHOLD  SHIFT  '.S) 

?2  READ (CRT. 1003) LENGTH. FNUM 

IF (LENGTH. LE.0) GO  TO  19000 
IJRITE(LUN'  WAR)FNUM 
GO  TO  K 

80  ASSIGN  90  TO  K 
LJRITE(CRT.ai) 

81  F0RMAT(1X.'(BG)  BACKGROUND  SUPPLIED  ?  '.*) 

82  READCCRT. 1002) LENGTH. ANS 
IF(LENGTH.LE.0)GO  TO  10000 
NUM-0 

IF(ANS.EQ.YES)NUM-1 
IJRITE(LUN'WAR)NUM 
GO  TO  K 

90  ASSIGN  100  TO  K 
URITE(CRT.91) 

91  FORMATdX.' (BS)  SUBTRACT  BACKGROUND  ?  '.*) 

92  RE AD ( CRT. 1 002 ) LENGTH . ANS 
IF (LENGTH. LE.0) GO  TO  10000 
NUM-0 

IF(ANS.EQ.YES)NUM-1 
URITE(LUN' IVAR)NUM 
GO  TO  K 
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0086 

0087 

0088 

0089 

0090 

0092 

0094 

0095 

0096 

0097 

0098 

0099 

0100 

0102 

0104 

0105 

0106 

0107 

0108 

0109 

0110 

0112 

0114 

0115 

0116 

0117 

0118 

0119 

0120 

0122 

0123 

0124 

0125 

0126 

0127 

0128 

0130 

0131 

0132 

0133 

0134 

0135 

0136 

0138 

0139 

0140 


C 

100  ASSIGN  110  TO  K 
URITE(CRT. 101) 

101  FORMATdX.' (BT)  COUNTING  TIME  FOR  BACKGROUND  (SECS)  '.$) 

102  READCCRT, 1003)  LENGTH. FNUM 
IF (LENGTH. LE.0) GO  TO  10000 
IF(FNUM.LE. 1.0)FNUM»1.0 
LJRITE(LUN'  IVAR)FNUM 

GO  TO  K 

110  ASSIGN  120  TO  K 
URITE(CRT. Ill) 

111  FORMATdX.' (CT)  COUNTING  TIME  FOR  UNKNOWN  SAMPLE  ',$) 

112  READ (CRT, 1003) LENGTH. FNUM 
IF (LENGTH. LE.0) GO  TO  10000 
IF(FNUM.LE. 1.0)FNUM-1.0 
IJRITE(LUN*  IVAR)FNUM 

GO  TO  K 

120  ASSIGN  130  TO  K 
IJRITE(CRT.  121) 

121  FORMATdX.' (VR)  VOLUME  REDUCTION  (OR  INVERSE  OF  DILUTION) ' .x,  IX 

1  *  FACTOR  ^  $) 

122  READ (CRT. 1003) LENGTH, FNUM 
IF (LENGTH. LE.0) GO  TO  10000 
IF(FNUM.LE. (1.0E-5))FNUM-1.0 
IJRITE(LUN'  IVAR)FNUM 

GO  TO  K 

130  ASSIGN  140  TO  K 
LJRITE(CRT.  131) 

131  FORMATdX.' (DT)  DECAY  TIME  '.$)- 

132  READ (CRT, 1003) LENGTH. FNUM 
IF (LENGTH. LE.0) GO  TO  10000 
(JRITE(LUN'  IVAR)FNUM 

GO  TO  K 

140  ASSIGN  150  TO  K 
IJRITE(CRT.  141) 

141  FORMATdX.' (MF)  RESULT  MULTIPLICATION  FACTOR  ',S) 

142  READ(CRT, 1003)LENGTH.FNUM 
IF (LENGTH. LE.0) GO  TO  10000 
LJRITE(LUN'  IVAR)FNUM 

GO  TO  K 

150  ASSIGN  180  TO  K 
WRITE (CRT, 151) 

151  FORMATdX. '  (BA)  BACKGROUND  SPECTRUM:  FILE.  ELEMENT  (.DEV  ICE)  '.x) 

152  READ (CRT, 1001) LENGTH, (A( I) . 1-1,32) 
iF (LENGTH. LE.0) GO  TO  10000 

DO  153  1-1.32.4 

153  WRITE(LUN' IVAR) A( I) . A( I+l) .A( 1+2) .A( 1+3) 

GO  TO  K 
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0141 

160 

ASSIGN  170  TO  K 

0142 

162 

IJRITE(CRT.  16n 

0143 

161 

F0RMAT( IX. 'ANALYSIS  OPTIONS  ') 

0144 

GO  TO  K 

0145 

170 

ASSIGN  180  TO  K 

0146 

URITE(CRT. 171) 

0147 

171 

FORMATCIX, ' (SB)  SUBTRACT  BACKGROUND  ?  '.$) 

0148 

172 

READCCRT. 1002) LENGTH. ANS 

0149 

IF(LENGTH.LE.0)GO  TO  10000 

0151 

URITECLUN' I VAR) ANS 

0152 

GO  TO  K 

0153 

180 

ASSIGN  190  TO  K 

0154 

IVAR-IWR+1 

0155 

URITECCRT. 181) 

0156 

181 

FORWTCIX.' (UD)  HOU  ARE  UEIGHTING  FACTORS 

0:  BASED  ON  ACTUAL  COUNTS/tHANNEL IX. 
1:  BASED  ON  CALCULATED  COUNTS/CHN  '.$) 


0157 

182 

READ (CRT. 1003) LENGTH. FNUM 

0158 

IF (LENGTH. LE.0) GO  TO  10000 

0160 

NUM-0 

0161 

IF(FNUM.EQ.1.0)NUM-1 

0163 

IJRITE(LUN'  IVAR)NUM 

0164 

GO  TO  K 

0165 

190 

ASSIGN  200  TO  K 

0166 

URITE(CRT. 191) 

0167 

191 

FORMATdX.' (NS)  NUMBER  OF 
1?**) 

0168 

192 

READCCRT. 1003) LENGTH. FNUM 

0169 

IF (LENGTH. LE.0) GO  TO  10000 

0171 

NUM-FNUM 

0172 

IF(NUM.GE.15)NUM-15 

0174 

IF(NUM.LE.1)NUM-1 

0176 

URITECLUN' IVAR)NUM 

0177 

GO  TO  K 
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0178 

200 

ASSIGN  210  TO  K 

0179 

WRITE (CRT, 201) 

0180 

201 

FORMATCIX.' (F0)  F-TEST  REJECTION  COEFFICIENT 

0181 

202 

READCCRT, 1003) LENGTH. FNUM 

0182 

IF (LENGTH. LE.0) GO  TO  10000 

0184 

IJR]TE(LUN'  IVAR)FNUM 

0185 

GO  TO  K 

0186 

210 

ASSIGN  220  TO  K 

0187 

WRITE(CRT,211) 

0188 

211 

FORMATdX.' (UF)  WEIGHTING  FACTOR  CALCULATION 

1. /. IX,'  -1:  (COUNTS)**-!  ' 

2, /, IX,'  0:  (SIGMA)**-2  ' 

S,/',  IX,'  1:  1  '.$) 

0189 

212 

READ (CRT, 1003) LENGTH. FNUM 

0190 

IF(LENGTH.LE.0)GO  TO  10000 

0192 

NUM-1 

0193 

IF(FNUM.EQ.0.0)NUM-0 

0195 

IF(FNUM.EQ. (-1.0))NUM»-1 

0197 

NUM-FNUM 

0198 

WRITE (LUN' IVAR)NUM 

0199 

GO  TO  K 

9200 

220 

ASSIGN  230  TO  K 

9201 

WRITE (CRT, 221) 

0202 

221 

FORMATdX.' (RC)  REJECTION  COEFICIENT  APPLIED 

0203 

222 

READ(CRT. 1002) LENGTH. ANS 

0204 

IF(LENGTH.LE.0)GO  TO  10000 

0206 

NUM-0 

0207 

IF ( ANS. EQ. YES) NUM-1 

0209 

WRITE(LUN'IVAR)NUM 

0210 

GO  TO  K 

0211 

230 

ASSIGN  240  TO  K 

0212 

WRITE (CRT. 231) 

0213 

231 

FORMATdX.' (BR)  BACKGROUND  REGRESSION  ?' 

1. /'.SX.'  0:  TRIAL  SET  -  CHOSEN  STANDARDS' 

2. /.6X.'  1:  TRIAL  SET  -  BACKGROUND  ONLY'.S) 

0214 

232 

READ (CRT. 1003) LENGTH. FNUM 

0215 

IF(LENGTH.LE.0)GO  TO  10000 

0217 

NUM-FNUM 

0218 

WRITE(LUN' IVAR)NUM 

0219 

GO  TO  K 

$) 
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0220 

C 

240 

ASSIGN  243  TO  K 

1 

0221 

URITE(CRT.241) 

■ 

0222 

241 

FORMATdX. '(BP)  PIVOT  ON  BACKGROUND  SPECTRUM  ALLOUED?* 

1, /,6X,'  0:  NO  PIVOT  ON  BACKGROUND  ALLOWED' 

2. /.6X.'  1:  ALLOW  PIVOT  ON  BACKGROUND  SPECTRUM'.*) 

• 

0223 

242 

READ (CRT, 1003) LENGTH, FNUM 

0224 

IF (LENGTH. LE.0) GO  TO  10000 

0226 

NUM-FNUM 

1 

0227 

WRITE(LUN' IVAR)NUM 

0228 

GO  TO  K 

V 

0229 

243 

ASSIGN  246  TO  K 

0230 

WRITE (CRT, 244) 

0231 

244 

FORMATdX,' (RQ)  OUTPUT  RESIDUALS  ?',*) 

0232 

245 

READ (CRT, 1002) LENGTH, ANS 

I 

0233 

IF ( LENGTH. LE.0)  GOTO  10000 

1 

0235 

NUM-0 

0236 

IF(ANS.EQ.YES)  NUM-1 

^i 

0238 

WRITE (LUN' IVAR)NUM 

0239 

GOTO  K 

% 

% 

0240 

246 

ASSIGN  250  TO  K 

N 

0241 

WRITE (CRT. 247) 

0242 

247 

FORMATdX.' (RS)  RESIDUAL  SPECTRUM:  FILE.ELEMENTC. DEVICE)') 

0243 

248 

READ ( CRT. 100 1 ) LENGTH , ( A ( I ) . I - 1 , 32) 

h 

0244 

IF (LENGTH. LE.0)  GOTO  10000 

■,* 

0246 

DO  249  I-1.32.4 

“b* 

0247 

249 

WRITE(LUN' IVAR)A(I).A(I+l),A(I+2).A(I+3) 

■w* 

0248 

GOTO  K 

0249 

250 

ASSIGN  10000  TO  K 

s 

0250 

I VAR -1 VAR-6 

■ 

IP 

0251 

READ (LUN' IVAR)NUM 

0252 

ITT-NUM 

0253 

IVAR-IVAR+5 

0254 

WRITE (CRT. 251) 

.•( 

i 

0255 

251 

FORMATdX. '(OR)  NUMBER  OF  LIBRARY  STANDARD  IN  ORDER  OF  DESIRED 
1' PR  INTOUT  ') 

1 

0256 

252 

DO  253  I-1,ITT 

> 

0257 

WRITE (CRT. 254) 

> 

« 

0258 

254 

FORMATdX.'  STANDARD  NUMBER  :  ',*) 

«!• 

0259 

READ(CRT. 1003) LENGTH. FNUM 

•P 

0260 

IF (LENGTH. LE.0) GO  TO  10000 

0262 

NUM-FNUM 

fl 

0263 

WRITE(LUN' IVAR)NUM 

■ 

0264 

253 

CONTINUE 

0265 

GO  TO  K 

0266 

450 

IVAR-1 

' 

0267 

IVAR-2 

i 

b 

/ 

h* 

l' 

w; 

0268 

ASSIGN  450  TO  K 

?. 

* 

X 

f: 

m 

? 

114 
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THIS  SECTION  ENABLES  MODIFICATION  OF  AN  EXISTING  FILE 


TO  MODIFY  ? 


0269 

500 

IJRITECCRT,501) 

0270 

501 

FORMATClX.'IJHICH  PARAMETER  DO  YOU  WISH 

0271 

READCCRT. 1000)LENGTH,ANS 

0272 

IF (LENGTH. LE.0) GO  TO  10000 

0274 

IF(ANS.EQ.UN)GO  TO  600 

0276 

IF(ANS.EQ.GN)GO  TO  610 

0278 

IF(ANS.EQ.TH)GO  TO  620 

0280 

IF(ANS.EQ.BG)GO  TO  630 

0282 

IF(ANS.EQ.BS)GO  TO  640 

0284 

IF(ANS.EQ.BT)GO  TO  650 

0286 

IF(ANS.EQ.CT)GO  TO  660 

0288 

IF(ANS.EQ.VR)GQ  TO  670 

0290 

IF(ANS.EQ.DT)GO  TO  680 

0292 

IF(ANS.EQ.MF)GO  TO  690 

0294 

IF(ANS.EQ.BA)GO  TO  700 

0296 

IF(ANS.EQ.LJD)GO  TO  720 

0298 

IF(ANS.EQ.NS)GO  TO  730 

0300 

IF(ANS.EQ.F0)GO  TO  740 

0302 

IF(ANS.EQ.UF)GQ  TO  750 

0304 

IFCANS.EQ.ROGO  TO  760 

0306 

IF(ANS.EQ.BR)GO  TO  770 

0308 

IF(ANS.EQ.BP)GO  TO  780 

0310 

IF(ANS.EQ.RO)  GOTO  782 

0312 

IF(ANS.EQ.RS)  GOTO  784 

0314 

IF(ANS.EQ.OR)GO  TO  790 

0316 

GO  TO  500 

0317 

600 

DO  601  1=1.32.4 

0318 

601 

READCLUN' IVAR) A( 1) . A( I  +  l) .A( 1+2) .AC  1+3) 

0319 

(JRITECCRT.51) 

0320 

URITECCRT. 1004) CAC I) . 1-1.32) 

0321 

IF(EDT.EQ.  DGO  TO  2000 

0323 

IVAR-IVAR-0 

0324 

GO  TO  52 

0325 

610 

IVAR-IVAR+8 

0326 

READCLUN*  I\/AR)FNUM 

0327 

LJRITECCRT.61) 

0328 

URITECCRT. 1007)FNUM 

0329 

IFCEDT.EQ.  DGO  TO  2000 

0331 

IVAR-IVAR-1 

0332 

GO  TO  62 
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0333 

C 

620 

IVAR-IVAR+9 

0334 

READ(LUN' IVARIFNUM 

0335 

IJRITECCRT,71) 

0336 

URITECCRT, 1007) FNUM 

0337 

IFCEDT.EQ.  DGQ  TO  2000 

0339 

I VAR -I VAR- 1 

0340 

GO  TO  72 

0341 

630 

IVAR=*IVAR+10 

0342 

READ(LUN* IVARINUM 

0343 

IJRITE(CRT.ai) 

0344 

ANS-NO 

0345 

IFCNUM.EQ.  DANS-YES 

0347 

(JRITECCRT.  1006)ANS 

0348 

IFCEDT.EQ.  DGO  TO  2000 

0350 

IVAR-IVAR-1 

0351 

GO  TO  82 

0352 

640 

IVAR-IVAR+11 

0353 

READCLUN' IVARINUM 

0354 

IJRITE(CRT.91) 

0355 

ANS-NO 

0356 

IFCNUM.EQ.  DANS-YES 

0358 

URITECCRT. 1006)ANS 

0359 

IFCEDT.EQ. 1) GO  TO  2000 

0361 

I VAR - 1 VAR- 1 

0362 

GO  TO  92 

0363 

650 

IVAR-IVAR+12 

0364 

READCLUN' WAR) FNUM 

0365 

URITECCRT. 101) 

0366 

URITECCRT,  1007)FNU(1 

0367 

IFCEDT.EQ. 1) GO  TO  2000 

0369 

WAR- 1  VAR- 1 

0370 

GO  TO  102 

0371 

660 

IVAR-IVAR+13 

0372 

READCLUN' WAR) FNUM 

0373 

URITECCRT. Ill) 

0374 

URITECCRT. 1007) FNUM 

0375 

IFCEDT.EQ. 1) GO  TO  2000 

0377 

WAR- 1  VAR- 1 

0378 

GO  TO  112 

0379 

670 

WAR-IVAR+14 

0380 

READCLUN' WAR) FNUM 

0381 

URIT-ECCRT.  121) 

0382 

URITECCRT, 1007) FNUM 

0383 

IFCEDT.EQ. 1) GO  TO  2000 

0385 

WAR- WAR- 1 

0386 

GO  TO  122 
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0387 

C 

680 

IVAR-IVAR+15 

0388 

READ(LUN' IVARIFNUM 

~  /•_ 

0389 

URITECCRT, 131) 

• 

0390 

URITECCRT, 1007)FNUM 

0391 

IF(EDT.EQ.  DGO  TO  2000 

0393 

I VAR “ I VAR- 1 

0394 

GO  TO  132 

0395 

690 

IVAR«IVAR+16 

0396 

READCLUN' IVARIFNUM 

0397 

URITECCRT, 141) 

0398 

UIRITECCRT,  1007)FNUM 

0399 

IF(EDT.EQ.  DGO  TO  2000 

0401 

I VAR- I VAR- 1 

0402 

GO  TO  142 

0403 

700 

IVAR-IVAR+17 

0404 

DO  701  1-1,32,4 

0405 

701 

READ(LUN'  IVAR)Ai:i),A<I+l),A<I+2),A<I+3) 

0406 

LJRITE(CRT,  151) 

0407 

LJRITE(CRT,  1004)  (A<  I) ,  1-1,32) 

0408 

IFCEDT.EQ.  DGO  TO  2000 

0410 

I VAR -I VAR-8 

0411 

GO  TO  152 

0412 

710 

IVAR-IVAR+25 

0413 

READCLUN' IVAR)NUM 

0414 

URITECCRT, 171) 

0415 

ANS-NO 

-V.  1 

0416 

IFCNUM.EQ.  DANS-YES 

0418 

URITECCRT, 1006)ANS 

0419 

IFCEDT.EQ.  DGO  TO  2000 

-  ■  "  * 

k  — Ifc  1  • 

0421 

I VAR - I VAR- 1 

Z:m 

0422 

GO  TO  172 

0423 

720 

IVAR-IVAR+26 

«>  *  h 

0424 

READCLUN’ IVAR)NUM 

•  •  « 
•  * 

0425 

IJ?ITE(CRT,  181) 

0426 

URITECCRT, 1005)NUM 

.“'.I 

0427 

IFCEDT.EQ.  DGO  TO  2000 

0429 

IVAR-IVAR-1 

rt: 

0430 

GO  TO  182 

0431 

730 

IVAR-IVAR+27 

1 ' " .  * 

0432 

READCLUN' IVAR)NUM 

.  '  *  • 

0433 

URITECCRT, 191) 

%-  J 
V‘j 

0434 

URITECCRT, 1005) NUM 

0435 

IFCEDT.EQ.  DGO  TO  2000 

0437 

IVAR-IVAR-1 

0438 

GO  TO  192 

s' 
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0439 

C 

740 

IVAR-IVAR+28 

0440 

READCLUN’ IVAR)FNUM 

0441 

IJRITE(CRT.20n 

0442 

IJRITE(CRT,  1007)  FNUM 

0443 

IFCEDT.EQ.  DGO  TO  2000 

0445 

IVAR=IVAR-1 

0446 

GO  TO  202 

0447 

750 

IVAR*IVAR+29 

0448 

READCLUN' IVARINUM 

0449 

URITE(CRT.21 1) 

0450 

UR  I TE (CRT, 1005) NUM 

0451 

IFCEDT.EQ.  DGO  TO  2000 

0453 

Iv/AR-IVAR-1 

0454 

GO  TO  212 

0455 

760 

IVAR=IVAR+30 

0456 

READCLUN' IVAR)NUM 

0457 

URITE(CRT.221) 

0458 

ANS-NO 

0459 

IFCNUM.EQ.  DANS-YES 

0461 

URITECCRT. 1006)ANS 

0462 

IFCEDT.EO.  DGO  TO  2000 

0464 

I VAR -I VAR- 1 

0465 

GO  TO  222 

0466 

770 

IVAR-IVAR+31 

0467 

READdUN'  I  VAR)  NUM 

0468 

UR  I TEC CRT, 231) 

0469 

URITECCRT. 1005) NUM 

0470 

IFCEDT.EQ.  DGO  TO  2000 

0472 

I VAR -I VAR- 1 

0473 

GO  TO  232 

0474 

780 

IVAR-IVAR+32 

0475 

READCLUN* IVAR)NUM 

0476 

URITECCRT, 241) 

0477 

URITECCRT, 1005)NUM 

0478 

IFCEDT.EQ.  DGO  TO  2000 

0480 

I VAR - I VAR- 1 

0481 

GO  TO  242 

118 
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0482 

782 

IVAR-IVAR+33 

0483 

READCLUN' IVARINUM 

0484 

LJRITE(CRT.244) 

0485 

ANS=NO 

0486 

IF(NUM.EQ.l)  ANS-YES 

0488 

UR  I TE (CRT. 1006 JANS 

0489 

IFCEDT.EQ.n  GOTO  2000 

0491 

I VAR = I VAR- 1 

0492 

GOTO  245 

0493 

784 

IVAR-IVAR+34 

0494 

DO  785  1=1,32.4 

0495 

785 

READ(LUN’  IVAR)A(I),A(I  +  l).Aa+2),A(I+3) 

0496 

URITE(CRT.247) 

049P 

URITE(CRT, 1004) (A( I) , 1=1,32) 

0498 

IF(EDT.EQ.l)  GOTO  2000 

8500 

I  VAR -I  VAR-8 

0501 

GOTO  248 

0502 

790 

IVAR=IVAR+27 

0503 

READCLUN' IVAR)NUM1 

0504 

ITT=NUM1 

0505 

URITE(CRT,251) 

0506 

IVAR=IVAR+14 

0507 

796 

URITE(CRT.792) 

0508 

792 

FORMATdX,'  ;  '.$) 

0509 

795 

DO  793  1=1. ITT 

0510 

READCLUN' IVAR)NUM 

0511 

UR  I TEC CRT. 794) NUM 

0512 

794 

F0RMAT('+'.I3,$) 

0513 

IFCI.LT. ia)GO  TO  793 

0515 

IFCITT.EQ. ia)GO  TO  793 

0517 

ITT-ITT-18 

0518 

GO  TO  796 

0519 

793 

CONTINUE 

0520 

IF(EDT.EQ.1)G0  TO  2000 

0522 

ITT=NUM1 

0523 

IVAR-IVAR-NUMl 

0524 

URITECCRT,797) 

0525 

797 

FORMATC'  ') 

0526 

GO  TO  252 

MIDAS  FORTRAN  IV 


11  FUG  1903  4:58:32  PM 


PAGE  013 


C 

052?  900  CONTINUE 

0528  CRT*6 

0529  EDT-1 

0530  UR  I TEC CRT. 901) 

0531  901  FORMAT C'l'.'  PREGA  UNKNOUN  SAMPLE  PARAMETERS'.//) 

0532  1 1-0 

0533  2000  II-II+l 

0534  I VAR -2 

0535  IF(II.GT.21)G0  TO  2001 

0537  GO  TO  (600,610.S20.630.S40.S50.GS0.S70.600.S90.700.720.730.740 

1.750.760.770.780.782.784.790)  II 


0538 

2001 

CONTINUE 

0539 

EDT«0 

0540 

UR  I TEC CRT. 1009) 

0541 

URITECCRT. 1008) 

0542 

URITECCRT. 1008) 

0543 

URITECCRT. 1008) 

0544 

URITECCRT. 1008) 

0545 

URITECCRT. 1008) 

0546 

URITECCRT. 1008) 

0547 

URITECCRT. 1008) 

0548 

CRT-5 

0549 

GO  TO  1500 

0550 

1000 

FORMAT CQ.A2) 

0551 

1001 

F0RMATCQ.32A1) 

0552 

1002 

FORMATCQ. lAl) 

0553 

1003 

FORMATCQ.E12.0) 

0554 

1004 

FORMATCIX  .'  :  '.32A1 

0555 

1005 

FORMATC'+',' ;  '.15./) 

0556 

1006 

FORMATC'+'.' ;  '.lAl./) 

0557 

1007 

FORMATC'+'.':  '.G14.G./) 

0558 

T008 

FORMAT C'+'.' 

0559 

1009 

FORMAT C'  ') 

0560 

11000 

CONTINUE 

0561 

END 
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OFFSET 

ATTRIBUTES 

A 

000006 

LOGICALiKi 

ARRAY  (32) 

CC 

000126 

INTEGER»2 

VARIABLE 

EDT 

003236 

INTEGER>t<2 

VARIABLE 

UN 

000046 

INTEGER>t<2 

VARIABLE 

OP 

000050 

INTEGER>K2 

VARIABLE 

CB 

000052 

INTEGER*2 

VARIABLE 

BG 

000054 

INTEGER>K2 

VARIABLE 

BS 

000056 

INTEGER»2 

VARIABLE 

BT 

000060 

INTEGER*2 

VARIABLE 

UT 

000122 

INTEGER*2 

VARIABLE 

VR 

000062 

INTEGER*2 

TRIABLE 

DT 

000064 

INTEGER»2 

VARIABLE 

MF 

000066 

INTEGER=K2 

VARIABLE 

SB 

000070 

INTEGER>t<2 

VARIABLE 

UD 

000072 

INTEGERix2 

VARIABLE 

NS 

000074 

INTEGER»2 

VARIABLE 

F0 

000076 

INTEGERH‘2 

VARIABLE 

(JF 

000100 

INTEGERw<2 

VARIABLE 

RC 

000102 

INTEGER*2 

VARIABLE 

BR 

000104 

INTEGER>t<2 

VARIABLE 

BP 

000106 

INTEGER*2 

VARIABLE 

ANS 

003240 

INTEGER*2 

VARIABLE 

YES 

000132 

INTEGER*2 

VARIABLE 

CRT 

003242 

INTEGER>X2 

VARIABLE 

RO 

000110 

INTEGER*2 

VARIABLE 

RS 

000112 

INTEGER*2 

VARIABLE 

GN 

000114 

INTEGER*2 

VARIABLE 

TH 

000116 

INTEGER>k2 

VARIABLE 

OR 

000120 

INTEGER*2 

VARIABLE 

CT 

000136 

INTEGER*2 

VARIABLE 

BA 

000140 

INTEGER»2 

VARIABLE 

NN 

000124 

INTEGER*2 

VARIABLE 

LL 

000130 

INTEGER*2 

VARIABLE 

NO 

000134 

INTEGER*2 

VARIABLE 

LUN 

003244 

INTEGER*2 

VARIABLE 

IVAR 

003246 

INTEGER*2 

VARIABLE 

M 

003250 

INTEGER*2 

VARIABLE 

LENGTH 

003252 

INTEGER*2 

VARIABLE 

K 

003254 

INTEGER*2 

VARIABLE 

I 

003256 

INTEGERJK2 

VARIABLE 

FNUM 

003260 

REAL=t<4 

VARIABLE 

NUM 

003264 

INTEGER’t^B 

VARIABLE 

ITT 

003266 

INTEGER>t<2 

VARIABLE 

NUMl 

003270 

INTEGER*2 

VARIABLE 

II 

003272 

INTEGERW2 

VARIABLE 
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NAI  MOD  44-0434-02  FLPY  M12  31  AUG  77  L.  HOLMES (SB) 

MODIFIED  5  JUN  81  BY  G.  PHILLIPS.  NRL 


MODIFIED  TO  "PREGA“  JULY  82  BY  B.  G.  GLAGOLA.  NRL 


COPYRIGHT  (C)  1977  BY  NUCLEAR  DATA  INCORPORATED 
SCHAUMBURG.  ILLINOIS  60196 


THIS  DOCUMENTATION  IS  FURNISHED  INCLUDING  THE  COPYRIGHT 
NUCLEAR  DATA  INCORPORATED.  IT  MUST  NOT  BE  REMOVED  AND  MAY  NOT 
BE  REPRODUCED  OR  REDISTRIBUTED  WITHOUT  THE  WRITTEN  EXPLICIT 
PERMISSION  OF  NUCLEAR  DATA. 


PURPOSE  OF  THE  PROGRAM: 

THIS  PROGRAM  DETERMINES  THE  ACTIVITY  OF  EACH  NUCLIDE  IN  A  SPECTRUM 
CONTAINING  SEVERAL  NUCLIDES  WHOSE  IDENTITIES  ARE  KNOWN  BUT  WHOSE 
ACTIVITIES  ARE  UNKNOWN.  THE  PROGRAM  ASSUMES  SPECTRAL  DATA  HAS 
BEEN  ACQUIRED  VIA  A  SODIUM  IODIDE  DETECTOR. 


METHOD; 

THE  PROGRAM  MAKES  A  CHANNEL  BY  CHANNEL  COMPARISON  BETWEEN  THE 
UNKNOWN  SPECTRUM  AND  A  SERIES  OF  STANDARD  SPECTRA.  IT  DETERMINES 
ACTIVITIES  BY  LEAST  SQUARES  RESOLUTION  OF  THE  SAMPLE  DATA  AND 
USES  PIVOTAL  REGRESSION  ANALYSIS  TECHNIQUES  TO  CALCULATE  AND 
LIST  THE  ACTIVITY  OF  EACH  NUCLIDE  WITH  ESTIMATED  ERROR 
AND  OTHER  INFORMATION  ABOUT  THE  ANALYSIS. 
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VARIABLE  DEFINITIONS 


GENERAL  CONTROL  PARAMETERS 
(USER  DEFINED) 


NS 

M 

NIT 

NBA 

NZ 

MF 

TB 

Q 

ASCCI) 


NUMBER  OF  ISOTOPES  IN  STANDARD  LIBRARY  (MAX-80) 
NUMBER  OF  CHANNELS  PER  STANDARD  (MAX-512) 

NUffiER  OF  ITERATION  FOR  THRESHOLD  8.  GAIN  CALC, 
BACKGROUND  SUBTRACT  (1-YES.0-NO) 

INITIAL  CHANNEL  FOR  COMPUTATION 
FINAL  CHANNEL  FOR  COMMUTATION 
COUNTING  TIME  FOR  BACKGROUND 
REJECTION  COEFFICIENT 

STANDARD  BACKGROUND  SPECTRUM  (FILE. ELEMENT!. DEVICE) ) 


CONTROL  PARAMETERS  FOR  EACH  LIBRARY  ELEMENT 


TISOT(JJ) 

HA(I) 

TST(I) 

AC(I) 

ASC(I) 


ISOTOPE  NAME  (8  CHARACTERS  MAX) 

HALF-LIFE  (SECS.) 

COUNTINUE  TIME  OF  STANDARD 
ACTIVITY 

STANDARD  SPECTRUM  (F ILE. ELEMENT!. DEVICE) ) 
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CONTROL  PARAMETERS  FOR  UNKNOUW  SAMPLE 
(USER  DEFINED) 

NBR  -  BACKGROUND  SUPPLIED  ?  ( YES- 1. NO-0) 

NBS  -  BACKGROUND  SUBTRACT  ?  ( YES- 1. NO-0) 

TB  -  COUNTING  TIME  FOR  BACKGROUND  (SECS) 

TSA  -  COUNTING  TIME  FOR  UNKNOUN  SAMPLE  (SECS) 

VRED  -  VOLUME  REDUCTION  FACTOR  (INVERSE  OF  DILUTION  FACTOR) 

DAY  -  DECAY  TIME  (SECS) 

VM  -  RESULT  MULTIPLICATION  FACTOR 

ASC(JJ)  -  SAMPLE  &  BACKGROUND  SPECTRUM  (FILE.ELEMENT(. DEVICE)) 


UNKNOIJN  SAMPLE  OPTION  VARIABLES 
(USER  DEFINED) 

NU  -  UEIGHTING  FACTOR  DETERMINATION  (BASED  ON  ACTUAL 

COUNTS/EHANNEL-0,  BASED  ON  CALCULATED  COUNTS^HN-1) 

N  -  NUMBER  OF  LIBRARY  SPECTRA  TO  BE  FITTED  TO  SAMPLE 

F0  -  F-TEST  REJECTION  COEFFICIENT 

LU  -  UEIGHTING  FACTOR  CALCULATION  ( (COUNTS)##-!— 1, 

-  (SIGMA) ##-2-0.  1-1) 

NEUST  -  APPLY  REJECTION  COEFFICIENT  ?  ( YES- 1, NO-0) 

BR  -  BACKGROUND  REGRESSION  (TRIAL  SET,  CHOSEN  STANDARDS-0, 

BACKGROUND  ONLY-1) 

BP  -  PIVOT  ON  BACKGROUND  ALLOUED  ?  (0-NO. 1-YES) 

IS(I)  -  NUMBER  OF  LIBRARY  STANDARD  USED  DURING  BUILDUP  REGRESSION 

ISL(I)  -  NUMBER  OF  LIBRARY  STANDARD  TO  BE  FIT  IN  ORDER  OF 

DESIRED  PRINTOUT 
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C 

0001  COMMON/'X/FUD 

0002  DIMENSION  A(  10. 10) .  Y(513)  .Z(  10)  .S(512)  .STDUO)  ,B(  10) 

1  RC512).U(512).  IR(:512),MY(10),FPM(10).FP(10) . 

2  BA(512),SS(10),  AC(10),HA(10),IS(10).  TSTC 10) ,HAT( 10) . 

3  TNAME(36).TISOTi:40).TISO(20).  IT(10),SNAM(2). 

4F  .R(10.64),HH(6).SIR(50). ISL(ia).HF(4), 

5IFORN(20). IFORKL(30),CC(10, 10) 

0003  DOUBLE  PRECISION  HG.HR.HT.HF 

0004  DATA  HF/8HFULL  SET.8HTEST  SET.BHBACKUARD.BHFORUARD  / 

0005  DATA  HG/'BHREGRESN.x.HR/BHRESIDUAL/'.HT/'BHTOTAL  / 

0006  DATA  HH/4HS0UR.4HCE  .4H  DF.4H  SS.4H  MS.4H  F  / 

0007  EQUIVALENCE  (BA. IR) , (ARR.S) . (TNAME(7) .SNAMC 1) ) 

0008  LOGICAL#!  ASC(60) .DEF( 10) .EF( 10) 

0009  LOGICAL*!  TNAME 

0010  REAL  TISO 

0011  INTEGER  C.D.E.F.MY.P.BR.BP 

0012  DATA  E/'0/ 

0013  DATA  MY/l. 2, 4.8. 16,32,64,  128,256,512x' 

0014  DATA  DEF/IHD, IHE, IHF. IH  , IH  .1H8,1H..1H  , IN  . IH  / 

0015  DATA  TIS1>'4HSAMP/,TIS2/"4HLE  z' 

0016  DEF(9) -.FALSE. 

0017  DEF( 10) -.FALSE. 

0018  ASC( 33) -.FALSE. 

0019  ASC( 34) -.FALSE. 

0020  INTEGER  FILE 

0021  FILE-8 

C 

C 

0022  DEFINE  FILE  9(4096. 2. U. IDAT) 

0023  DEFINE  FILE  1 1 (4096. 2,U, IDAT) 

0024  DEFINE  FILE  10(0.2.U. IVAR) 
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0025 

0026 

0027 

0028 

0029 

0030 

0031 

0032 

0033 


0034 

0035 

0036 

0037 

0038 

0039 

0040 

0041 

0042 


0043 


0044 

0045 

0046 


MI-9 
MIU-11 
MO -6 

URITE(MO.900) 

900  FORMATC'l','  OUTPUT  FOR  PREGA  ANALYSIS  PROGRAM'.///) 

C  CHANGE  RANGE  OF  NEXT  DO  LOOP  TO  MAX  NR  OF  CHANNELS 
DO  1  1-1,512 

1  BA(I)-0.8 
NNN-0 
IPO-0 

C 

C  GENERAL  CONTROL  PARAMETERS 
C 

2  READ  (MI 'DNS 
READ(Mr2)M 
READ(MI'3)NIT 
READ (MI* 4) NBA 
READ(MI'5)NZ 
READ(Mr6)MF 
READ(Mr40)TB 
READ<Mr41)Q 
NCH-MF-NZ+1 

C 

C  (USER  DEFINED) 

C  NS  -  NUMBER  OF  ISOTOPES  IN  STANDARD  LIBRARY  (MAX-80) 

CM  -  NUMBER  OF  CHANNELS  PER  STANDARD  (MAX-512) 

C  NIT  -  NUMBER  OF  ITERATION  FOR  THRESHOLD  &  GAIN  CALC. 

C  NIT  IS  TO  BE  REMOVED  IN  FUTURE  STREAMLINING  OF  PROGRAM 
C  NBA  =  BACKGROUND  SUBTRACT  (1-YES.0-NO) 

C  NZ  -  INITIAL  CHANNEL  FOR  COMPUTATION 

C  MF  -  FINAL  CHANNEL  FOR  COMPUTATION 

C  TB  -  COUNTING  TIME  FOR  BACKGROUND 

CO  -  REJECTION  COEFFICIENT 

C 
C 

D  WRITE  (MO.  901)NS,M,NIT.NBA.NZ.MF 

IF(NS)897,897.3 

C  >Mok«««:l(«:toM(«»:K:K»}toKlo|oMOMo|o|OMoto|oK!K}K:)o<(:<o<a<oM040K)|oK!(<>K««:Mo<o(o^ 

C 

C 

C 

3  JJ-1 

DO  10  I-l.NS 
IDAT-65+(I-l)#16 


MIDAS  FORTRAN  IV 


5  OCT  1983  1:36:04  PM 


PAGE  006 


C 

C 

C  CONTROL  PARAMETERS  FOR  EACH  LIBRARY  ELEMENT 
C 

0047  READCMI' IDAT)TISOT(JJ) 

0048  JJ-JJ+1 

0049  READ (MI ' IDAT) TISOTC JJ) 

0050  JJ-JJ+1 

0051  IDAT-IDAT+8 

0052  READ  (Mr  IDAT)  HA(  I) 

0053  READ(Mr  IDAT)TST(n 

0054  READ (MI* IDAT) AC (1) 

C 

C  TISOT(JJ)  =•  ISOTOPE  NAME  (3  CHARACTERS  MAX) 

C  HA(I)  »  HALF-LIFE  (SECS.) 

C  TST(I)  »  COUNTINUE  TIME  OF  STANDARD 

C  AC(I)  »  ACTIVITY 

C 


0055 


10  CONTINUE 
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0056  IF  (NBA)  50.50,40 

0057  40  I DAT-42 

0058  DO  45  J- 1,32. 4 

C 

C  ASC(I)  -  STANDARD  BACKGROUND  SPECTRUM  (F ILE.ELEMENTC. DEVICE) ) 

C 

C 

0059  45  READCMI' IDAT)ASC(J).ASC(J+l),ASC(J+2),ASC(J+3) 

0060  LJRITE(MO. 902)  (ASC<  I),  1-1,32) 

0061  902  FORMAT (IX' STANDARD  BACKGROUND:  ',32A1) 

0062  CALL  GET(ASC.BA.IVAR.FILE,M) 

0063  URITE  (MO.903) (BA(I). I-l.M) 

C 

0064  50  DO  130  I-1,NS 

0065  IDAT-65+( I-l)#16+2 

0066  DO  52  J-1,32,4 

C 
C 

C  ASC(I)  -  STANDARD  SPECTRUM  (F ILE.ELEI^NTC, DEVICE) ) 

C 

0067  52  READCMI’ IDAT)ASC(Jl,ASC(J+l).ASC(J+2),ASC(J+3) 

0060  CALL  GET(ASC.S.IVAR.FILE.M) 


0069  IF(NBA)  70,70.60 

C 
C 

C  SUBTRACT  BACKGROUND  (MULTIPLIED  BY  COUNT  TIME  OF  STANDARD/  COUNT 

C  Tirt  OF  BACKGROUND)  FROM  STANDARD 

C 

0070  60  FAT-TST(I)/TB 

0071  DO  65  J-1,M 

0072  S(J)-S(J)-BA(J)*FAT 

0073  65  CONTINUE 

C 
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C 

C  DON'T  LET  STANDARD  COUNTS  BE  LESS  THAN  .01 
C 

0074  70  DO  75  J-1,M 

0075  IF(S(J) .LT.0.0)S(J)=.01 

0077  75  CONTINUE 

0078  IF(NBA)  100.100,80 

0079  80  URITE(MO.904)  (ASCdl),  II»1,32) 

0080  904  FORMAT('0'. 'BACKGROUND  SUBTRACTED  STANDARD:  '.32An 

0081  lJRITEi:rtD.903)(S(Jl.J=*l.M) 

0082  100  CONTINUE 

C 
C 

C  SAVE  STANDARD  SPECTRUM  IN  VIRTUAL  MEMORY  OUT  ON  DISK 

C 

0083  IVAR-(I-1)*M+1 

0084  DO  120  K-l.M 

0085  120  IJRITE(10' IVAR)S(K) 

0086  130  CONTINUE 

0087  170  URITE  (MO. 908) 


C 
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C 

C 

C 

0088 

0089 

0098 

0091 

0092 

3093 

0094 

0095 


C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 


CONTROL  PARAMETERS  FOR  UNKNOUN  SAMPLE 
IDAT-12 

READCMIU' IDATINBR 
READCMIU' IDATINBS 
READCMIU* IDATITB 
READCMIU* IDATITSA 
READCMIU' IDATIVRED 
READCMIU* IDATIDAY 
READCMIU* IDATIVM 

CUSER  DEFINED) 

NBR  -  BACKGROUND  SUPPLIED  ?  CYES-l,NO-0) 

NBS  =>  BACKGROUND  SUBTRACT  ?  CYES»l,NO-0) 

TB  -  COUNTING  TIME  FOR  BACKGROUND  CSECS) 

TSA  -  COUNTING  TIME  FOR  UNKNOUN  SAMPLE  CSECS) 

VRED  -  VOLUME  REDUCTION  FACTOR  C INVERSE  OF  DILUTION  FACTOR) 

DAY  =■  DECAY  TIME  (SECS) 

VM  -  RESULT  MULTIPLICATION  FACTOR 
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0096 

180 

IF  (VM)  190.190.200 

0097 

190 

VM- 1 . 0 

0098 

200 

IF  (VRED)  210.210.220 

0099 

210 

VRED-1.0 

0100 

220 

IF  (TB)  230.230.240 

0101 

230 

FS-0.0 

0102 

GO  TO  250 

0103 

240 

FS-TSA/TB 

0104 

250 

FX-FS+FS>toK2 

0105 

IF(NBR)  270.270.260 

0106 

260 

CONTINUE 

C 

C 

C  ASC(JJ5  >  SAMPLE  8.  BACKGROUND  SPECTRUM  (F ILE.ELEMENTC. DEVICE) ) 

C 

0107  DO  265  JJ-1,32,4 

0108  265  READ(MIU'IDAT)ASCCJJ),ASC(JJ+l),ASC(JJ+2),ASCCJJ+3) 

C 

C  URITE(MO, 910) (ASC( I). 1-1.32) 

C910  FORMATCl HI. 'SAMPLE  BACKGROUND:  '.32A1) 

C 

0109  CALL  GETCASC.BA. IVAR.FILE.M) 

C  URITE  (MO.903) (BA(I). I-1,M) 

0110  270  CONTINUE 

0111  IDAT-2 

C 

0112  DO  280  JJ-1.32.4 

0113  280  READ(MIU' IDAT)ASCi:jJ).ASC(JJ+l),ASC(JJ+2).ASC(JJ+3) 
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C 

0114  URITE(M0.9in  (ASCi:n.I  =  1.32) 

0115  911  FORMAT('  'SAMPLE  SPECTRUM:  ',32A1) 

C 

C 

0116  DO  290  I=>1,32 

0117  290  TNAME ( I) =ASC ( n 

0118  CALL  GETCASC.Y. IVAR.FILE.M) 

C 

0119  IF  (NBS)  310.310.300 

0120  300  DO  305  I-1,M 

0121  305  YCn-Y(n-BA(I)*FS 

0122  310  SB»0.0 

0123  DO  320  I=*NZ.MF 

0124  320  SB-SB+BA(I) 

0125  (JRITE  (MO.903)(Y(D,  I-I.M) 

0126  S1>0.0 

0127  S2-0.0 

0128  DO  330  I=N2.MF 

0129  330  Sl-Sl+Yd) 

0130  S2-S1+SB*FX 

0131  URITE  (MO.  912)SB.S1 

C 

c 

C  SAVE  ORIGINAL  SAMPLE  SPECTRUM  OUT  ON  DISK 
C 

0132  IVAR-(NS+21)KM+1 

0133  DO  340  I-1,M 

0134  340  URITE(10'IVAR)Y(D 
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0135 


0136 

0137 

0138 

0139 

0140 

0141 

0142 

0143 

0144 

0145 

0146 

0147 


C 

C 

IDAT-IDAT+18 

C 

C  UNKNOWN  SAMPLE  OPTION  VARIABLES 
C 

NB=0 

READCMIU' IDATINU 
READCMIU' IDAT)N 
READCMIU' IDAT)F0 
READCMIU’  IDAT)LIJ 
READCMIU’  IDAT)NEIJST 
READCMIU’ IDAT)BR 
READCMIU’ IDAT)0P 
READCMIU’ IDATJKRO 
DO  350  1-1.32.4 

350  READCMIU’ IDAT)  ASCC I) .ASCC I+U .ASCC 1+2) .ASCC 1+3) 
NDET-0 
C 

C  CUSER  DEFINED) 


c 

c 

NU 

m 

WEIGHTING  FACTOR  DETERMINATION  CBASED  ON  ACTUAL 
COUNTS/CHANNEL-0.  BASED  ON  CALCULATED  COUNTS/CHN-1) 

c 

N 

n 

NUMBER  OF  LIBRARY  SPECTRA  TO  BE  FITTED  TO  SAMPLE 

c 

F0 

a 

F-TEST  REJECTION  COEFFICIENT 

c 

LU 

a 

WEIGHTING  FACTOR  CALCULATION  C  C COUNTS) **-1  —  1. 

c 

a 

CSIGMA)**-2-0.  1-1) 

c 

NEUST 

a 

APPLY  REJECTION  COEFFICIENT  ?  CYES-l.NO-0) 

c 

C- 

BR 

a 

BACKGROUND  REGRESSION?  C TRIAL  SET.  CHOSEN  SET 

OF  STANDARDS-0.  BACKGROUND  ONLY-0) 

L 

c 

BP 

. 

PIVOT  ON  BACKGROUND  ALLOLED  ? 

c 

c 

-0  NO  PIVOT  ON  BACKGROUND  ALLOWED 
-1  ALLOW  PIVOT  ON  BACKGROUND 

C  KRO  -  OUTPUT  RESIDUALS  ?  CYES-l.NO-0) 

C  ASC  -  FILENAME  FOR  RESIDUALS 

C  ISC  I)  -  NUMBER  OF  LIBRARY  STANDARD  TO  BE  FIT  IN  ORDER  OF 

C  DESIRED  PRINTOUT 
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0148 

0149 

0150 

0151 

0152 

0153 

0154 

0155 

0156 


0157 

0158 

0159 

0160 

0161 


0162 

0163 

0164 

0165 

0166 

0167 

0168 


C 

DO  360  I»1.NS 
360  ISL(D=*0 

DO  370  I»1.N 
READ(MIU'IDAT)IS(n 
370  ISLtD-ISCI) 

C 

DO  380  J-l.N 
DO  375  I-l.NS 
IF(IS(J)-n  372,372.375 
372  11-2*1-1 
C 
C 

C  STORE  IN  ARRAY  TISO  ONLY  THOSE  LIBRARY  NAMES  ACTUALLY  USED  IN  THE 
C  LEAST  SQUARES  FIT 
C 

JJ-2*J-1 

TISO(JJ)-TISOT(in 

II-II+l 

JJ-JJ+1 

TISO(JJ)-TISOT(ID 

C 

GO  TO  380 
375  CONTINUE 
380  CONTINUE 

TIS0((N+n*2-U-SHAM(l)  ' 

TIS0((N+l)*2)-SNAM(2) 

IS(N+1)-N+1 

LN-N+1 
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DO  390  J-l.N 
390 

DO  395  1*1. N 
IFCISCI) .EQ. 1)  GO  TO  400 
395  CONTINUE 

y?ITE(M0.913) 

913  FORMAT('0'.5X.45('#')/^X,'*'.45X,*»'/5X.'>t«',4X. 
X* BACKGROUND  HOT  INCLUDED  AS  A  STANDARD' .4X. 

X5X. '  ,  45X, '  /SX.  45  ( '  ♦' ) /) 

400  CONTINUE 
IF(BP.EQ.0)  GO  TO  401 
URITE(M0.936) 

401  DO  402  I-1,N 

402  EF(D-.FALSE. 

SET  UP  ARRAY  A(N+1.N+1) 

405  DO  420  I-l.M 

IF(LIJ)  422.412.410 
410  tJ<I)>1.0 
GO  TO  420 

412  T-Y(I)+BA(:i)*FX 

IF  (T-  1.0)  414.414.416 
414  IK  I) -1.0 
GO  TO  420 
416  UCI)-1.0/'T 
420  CONTINUE 
GO  TO  424 

422  DO  423  I-1,M 

423  Udl-l.O/CYdl+l.O) 
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0196  424  SUMU-0.0 

0197  DO  425  I»1,M 

0198  425  SUMU-SUMU+1.0/U(n 

0199  IJRITE(M0,914) 

0200  914  FORMAT <:'0','>MototoK  CORRELATION  MATRIX  jioiomok'/) 

0201  ENCODEC 17.915,  IFORN)  LN 

0202  915  F0RMAT('(14X.',I2.*(2A4.2X)/')') 

0203  URITECMO, IFORN)  (TISO( 1*2-1) .TISO( 1*2) . I-1,LN) 

0204  DO  446  L-1,N 

0205  N5=-IS(L) 

0206  I VAR  « ( N5- 1 ) *M+N2 

0207  DO  435  J-NZ.MF 

0208  435  READ(10* IVAR)R(J) 

C 

C  COMPUTE  UEIGHTED  SUMS  OF  STANDARD  SPECTRA 

C 

0209  SS(L)-0. 

0210  DO  436  J-NZ.MF 

0211  436  SS(L)-SS(:L)+R(J)*IJ(J) 

0212  DO  444  K-L.N 

0213  N6-IS(K) 

0214  IVAR»(N6-1)*M+N2 

0215  DO  437  J-NZ.MF 

0216  437  READ<10' IVAR)S(J) 

0217  442  SA-0. 
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C 

C  GET  LEAST  SQUARES  SUM  COEFFICIENTS  FOR  UNKNOWN  CONCENTRATIONS  Z(I) 

C  AND  SAMPLE  Y(D 

C 

0218  DO  443  I-NZ.MF 

0219  443  SA-SA+S(nH<R(I)*U(I) 

0220  ACK.D-SA 

0221  A(L,K)-A(K.L) 

0222  444  CONTINUE 

0223  SA-0. 

0224  DO  445  I-NZ,MF 

0225  SA-SA+R(n*YC 

0226  445  CONTINUE 

0227  B(L)-SA 

0228  A(N+1,L)-SA 

0229  A(L,N+1)-A(N+1,L) 

0230  446  CONTINUE 

0231  SA-0. 

0232  DO  450  I-NZ.MF 

0233  SA-sA+Yi:n)t<Y(n#u(n 

0234  450  CONTINUE 

0235  A(LN,LN)-SA 

0236  ST-SA 

C 

C  COMPUTE  WEIGHTED  SUM  OF  UNKNOLW 

C 

0237  SS(LN)-0. 

0238  DO  460  J-MZ.NF 

0239  460  SS(LN)-SS<LN)+Y(J)*U(J) 
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C 

C  CALCULATE  CORRELATION  MATRIX 

C 

0240  DO  468  L’-l.LN 

0241  NS-ISCL) 

0242  DO  465  K-L.LN 

0243  N6-IS(K) 

0244  SRD1-A(K.K)-SS(N6)**2/'SUMU 

0245  SRD2-A(L.L)-SS(N5)**2/SUry 

0246  CC(K.L)-(A(K.L)-SS(N6)*SS(N5)/^UMU)/SQRT(SRD1*SRD2) 

0247  465  CONTINUE 

0248  LSK-(L-n*10+2 

0249  KAC-LN-L+1 

0250  ENC0DE(25,916,  IFORKL)  LSK.KAC 

0251  916  F0RMAT('(2X.2A4.',I2.'X,',I2.'(F8.4,2X)/)') 

0252  UR  I TE (MO. IFORKL)  TIS0(L*2-1) .TIS0(L*2) , (CC(K.L) ,K-L,LN) 

0253  468  CONTINUE 

C 

C  PRINT  OUT  LEI GATED  SUMS  OF  STANDARDS  AND  UNKNOUN 

C 

0254  LJRITE(MO.905) 

0255  URITE(MO.906)  (SS( I) . I-l.LN) 
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C 

C 

C 

C  DO  PIVtlTAL  REGRESSION  ANALYSIS 

C 

C 

C  REGRESSION  UITH  ALL  REQUESTED  STANDARDS 

C 


0256 

E-0 

0257 

P-N 

0258 

IF(0R.EQ.0)  GO  TO  479 

0260 

IJRITECMO,930) 

0261 

DO  470  I-l.N 

0262 

IFCISLCn  .EQ.  1)  GO  TO 

0264 

470 

CONTINUE 

0265 

471 

N5-ISL(D 

0266 

E-E+MY(N5) 

0267 

CALL  PIVOTCA. I.EF.LN) 

0268 

IPO-1 

0269 

P-1 

0270 

GO  TO  700 

0271 

479 

DO  480  I-1,P 

0272 

E-E+MY(IS(I)) 

0273 

CALL  PIVOTCA. I.EF.LN) 

0274 

480 

CONTINUE 

0275 

IPO-1 

0276 

GO  TO  700 

C 


139 
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C 

C  SELECT  TRIAL  SUBSET  OF  MATRIX  A 
C 


0277 

500 

F-E 

0278 

D«0 

0279 

IF(BR.EQ.0)  GO  TO  502 

0281 

F»0 

0282 

DO  501  I-l.N 

0283 

N5-ISL(I) 

0284 

F-F+MY<N5) 

0285 

501 

CONTINUE 

0286 

GO  TO  609 

0287 

502 

P-N 

0288 

508 

DO  510  I-1,N 

0289 

N5-ISLn) 

0290 

IFOP.EQ.n  GO  TO  509 

0292 

IF(N5.EQ. 1)  GO  TO  510 

0294 

IFCSTDd)  .LE.0.0)  GO  TO  511 

0296 

509 

IF(Z(l)ySTD(I) .GE.1.0)  GO  TO 

510 

0298 

511 

CALL  PIVOT(A.  LEF.LN) 

0299 

E-E-MY(N5) 

0300 

P»P-1 

0301 

510 

CONTINUE 

0302 

IF(E.EQ. 1.AND.Z(1).LT.0.0)  GO  TO  890 

0304 

p 

IF(E.GT,0)  GO  TO  540 

L 

c 

p 

FIND  LARGEST  F- VALUE  AND  USE 

THAT  STANDARD  AS  THE  TRIAL  SET 

0306 

FPS-0.0 

0307 

DO  530  I-1,N 

0308 

IF(Z(n)  530.530,520 

0309 

520 

IF<FP(n  .LT.FPS)  GO  TO  530 

0311 

FPS-FP(D 

0312 

J-I 

0313 

530 

CONTINUE 

0314 

P-1 

0315 

E-E.AND.MY(ISL(J)) 

0316 

540 

IPO-2 

0317 

GO  TO  700 
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C 

C  8ACKUARD  PIVOT 
C 


0318 

550 

o 

II 

m 

0319 

IFCE.EQ. 1.AND.BP.EQ.0)  GO  TO  800 

0321 

551 

FMIN-10000. 

0322 

DO  555  1=1. N 

0323 

FPM(D=1000. 

0324 

N5-ISLn) 

0325 

IFCBP.EQ.U  GO  TO  552 

0327 

IF(N5.EQ.n  GO  TO  555 

0329 

552 

IN-C.AND.MY(N5) 

0330 

IF(IN)  555,555,554 

0331 

554 

FPM(n=(NCH-P)*((A(I,LN)>toK2)/(-A(I,  DsKACLN.LN) ) ) 

0332 

IF(A<I,LN)  .GT.0.0)  FPM(n=-FPM(I) 

0334 

IF(FPM(n  .GE.FMIN)  GO  TO  555 

0336 

FMIN=FPM(I) 

0337 

J  =  I 

0338 

555 

CONTINUE 

0339 

DF«NCH-P 

0340 

2S=-A(J,LN) 

0341 

IFCFMIN.LT.O.O)  FMIN— FMIN 

0343 

CALL  XQCALC(DF,FMIN.2S.XF,QF.0) 

0344 

IF(XF.GE.F0)  GO  TO  560 

0346 

CALL  PIVOT(A.J.EF.LN) 

0347 

E-E-MY(ISL(J)) 

0348 

P=P-1 

0349 

560 

IP0=3 

0350 

GO  TO  700 

0351 

600 

JDF-F-D 

0352 

IF(E.EO.JDF)  GO  TO  800 
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0354 

0356 

0357 

0359 

0360 

0361 

0362 

0363 

0364 

0365 

0367 

0369 

0370 

0371 

0372 

0373 

0375 

0376 

0377 

0378 

0380 

0381 

0383 

0384 

0385 

0386 

0387 

0388 

0389 

0391 

0393 

0394 

0395 

0396 

0397 

0398 

0400 

0401 

0402 

0403 

0404 

0405 

0406 

0408 


C 

C  FORWARD  PIVOT 
C 

609  IF(BR.EQ.l)  C«E 
D-F-C 

IFCD.EQ.O)  GO  TO  630 
FMAX-0.0 
DF-NCH-P-1 
WRITE (MO, 932) 

DO  620  I-l.N 

FPM(I)-0.0 

N5-ISL(I) 

IFCBP.EQ. 1)  GO  TO  610 
IF(N5.EQ. 1)  GO  TO  620 

610  IN-D.AND.MY(N5) 

IF(IN)  620,620,615 

615  INEG-0 
SQUC-A(I,I)>t<A(LN,LN) 

IF(SQUC.GT.0.0)  GO  TO  616 
SQUC— 1.0*SQUC 

INEG-1 

616  RHO-A(I,LN)/SQRT(SQUC) 

IFdNEG.EQ.  1)  RHO— 1.0»RHO 
R2-RH0’»k2 

IFdNEG.EQ. 1)  R2— 1.0*R2 
FPMCI ) -DF*R2/d  .  0-R2) 

ZS-Ad,LN) 

FPS-FPMCI) 

CALL  XQCALC(DF,FPS,ZS,XF,QF.0) 

RMSR-A (LN, LN) 1 . 0-R2) /DF 

WRITE(M0,933)  TIS0d*2-l)  ,nS0d*2),FPS,QF,XF,RH0.RMSR 
IF(XF.LT.0.0)  FPMd)— FPMd) 

IF(FPMd)  .LE.FMAX)  GO  TO  620 
FMAX-FPMd) 

J-I 

620  CONTINUE 
2S-A(J,LN) 

CALL  XQCALC(DF,FMAX,ZS,XF,QF,0) 

IF(XF.LT.F0)  GO  TO  630 
CALL  PIVOT(A,J,EF,LN) 

E-E+MYdSL(J)) 

P-P+1 
IPO -4 
BR-0 

GO  TO  700 

630  IF(E.EQ.C)  GO  TO  800 
GO  TO  550 
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C 

C  OUTPUT  SECTION  FOR  PARTIAL  F,Q,X  AND  ANALYSIS  OF  VARIANCE 
C 

0409  700  J-0 

0410  DF»NCH-P 

0411  RSS=A(LN.LN) 

0412  RMSR-RSS/DF 

0413  DO  730  I-l.N 

0414  NS-ISLCD 

0415  IN=E.AND.MY':N5) 

0416  IF(IN)  730.730,720 

0417  720  J-J+1 

0418  TIS0T(2*J-n=TIS0(2*I-l) 

0419  TIS0T(2*J)-TIS0(2*I) 

0420  A(I,LN)*TST(NS1/TSA 

0421  SQUC-A(I,n 

0422  IF(SQUC.LT.0.0)  SQUC--1 .05)«SQUC 

0424  STD  ( J )  -SORT  (  SQUC>kRMSR  )  *TST  ( N5 )  /TSA 

0425  FP(J)-(2(J)/6TD(J))*3«2 

0426  730  CONTINUE 

0427  URITE(M0,9181  HF( IPO) .SNAM( 1) ,SNAMC2) 

0428  918  FORMAT(' 1',' RESULTS  OF  '.AS,'  REGRESSION  ON  '.2A4.W) 

0429  WRITE (MO. 9 19)  DF.RSS.RMSR 

0430  919  FORMAT ('  '.'DEGREES  OF  FREEDOM-' ,F1 1 .0/* 

X13X. 'RSS-'.  1PE11.3/13X, 'MSR*',  1PE11.3//') 

0431  DO  740  1=1, P 

0432  FPS-FP(I) 

0433  ZS-2(I) 

0434  CALL  XQCALC(DF.FPS,ZS,XF,QF,0) 

0435  FP(I)-XF 

0436  RMSR-A(LN,LN)»(1.0+FPS/'DF)/(DF+1) 

0437  738  URITE(MO,920)  TISOT( 1*2-1) ,TISOT( 1*2) ,2( I) .STD( I) .FPS.QF.XF.RMSR 

0438  920  FORMATC  ' ,2X,2A4, 1PE13.4.2X. , IPEl 1 .2,3X. 'F-' , 

XlPE12.4,3X,'a-',lPE12.4,3X.'X-',lPE12.4,3X,'RMSR-',lPE12.4) 

0439  740  CONTINUE 

0440  GO  TO  (500,550,600.630), IPO 
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0441 

0442 

0443 

0445 

0446 

044?’ 

0448 

0449 

0450 

0451 

0452 

0453 


C 

C  FINAL  RESULT  SECTION 
C 

800  SG-e 
J-0 

IF(E.EQ.  l.AND.Zd)  .LT.0.0)  GO  TO  890 

DO  820  I-1,N 

NS-ISLCI) 

IN-E.AND.MY(N5) 

IF(IN)  820.820.815 
815  J-J+1 

SG-SG-A(I.LN)*8(n 
TIS0Ti:j*2-n-TIS0(  1*2-1) 
TIS0T<J*2)-TIS0<I*2) 

820  CONTINUE 
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0454 

C 

CH«0.0 

0455 

VY-0. 

0456 

vu-0.a 

0457 

VW-0.0 

0458 

C 

JJJ-0 

C 

C 

THIS  LOOP  READS  FROM  A  SCRATCH  FILE  INTO  CORE  UP 

TO 

15 

C 

STANDARDS,  64  CHANNELS  AT  A  TIME  SO  THAT  RESIDUALS 

AND 

STANDARD 

C 

ERRORS  MAY  8E  DETERMINED 

0459 

L 

DO  835  J-NZ.MF 

0460 

JJJ-JJJ+1 

0461 

SV-0. 

0462 

JJ-0 

0463 

DO  828  I-1,N 

0464 

N5-ISL(I) 

0465 

IN-E.AND.MY(N5) 

0466 

IF(IN)  828,828.822 

0467 

822 

JJ-JJ+1 

0468 

IF ( JJJ. GT. 1. AND.JJJ.lt. 65) GO  TO  827 

0470 

JJJ-1 

0471 

LOOP-(MF+l)-J 

0472 

IF(LOOP.GT.64)LOOP-64 

0474 

IVAR-(N5-n*M+J 

0475 

DO  826  II-l,LOOP 

0476 

826 

READ<10' IVAR)ARR(JJ, II) 

D' 

IJRITE(MO.903)  (ARR(JJ.  1 1) ,  1 1-l,LOOP) 

0477 

827  SV-SV+ARR(JJ,JJJ)*(-A<I.LN)) 

0478 

IFCJJ.EQ.P)  JJ-0 

0480 

828 

CONTINUE 
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0481 

RE=Y(J)-SV 

0482 

T=RE**2 

0483 

VY=VY-KJ(J)>KT 

0484 

VU-VU+T 

0485 

TMO-ABSC0. 1+SV) 

0486 

TMP»TMO+BA<J)>KFX 

0487 

WV-VW+TMP 

0488 

IF  (NU)  833,833.830 

0489 

830 

IF  (LU)  832.831.833 

0490 

831 

U(J)=*1.0/TMP 

0491 

GO  TO  833 

9492 

832 

UCJi-KO/TMO 

0493 

833 

RT»T/TMP 

0494 

CH-CH+RT 

0495 

TMP»SQRT(TMP) 

0496 

0497 

0498 

0499 


C 

C 

C 

C 


835 


CALCULATES  RESIDUALS  OVER  STANDARD  DEVIATION.  R(J) 

R(J)-RE/'TMP 

TE-Y(J)+BA(J)>KFX 

CONTINUE 

SR-VY 
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0500 

0501 

0502 

0503 

0504 

0505 

0506 

050? 

0508 

0509 

0510 

0511 

0512 

0513 

0514 


0515 


C  CALCULATES  NUMBER  OF  DEGREES  OF  FREEDOM,  DN 
C 

DN=MF-P-NZ+1 

DR-DN 

DG=P 

DT-DR+DG 

CHDF=CH/'DN 

VY=VY/DN 

URITE(MO,896) 

(JRITE(M0.934)  SNAMC 11  ,SNAM(2) 

URITE  CMO.  921)CHDF 

J=0 

840  DO  844  I=«1,N 
N5=»ISLai 
IN=E.AND.MY(N5) 

IFUN)  844.844,841 

841  J=J+1 
C 

C  DECAY  CORRECTION  DONE  HERE 
C 

FD=  EXP(a,693*DAY/HA(NS)) 
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C 

C  CORRECTED  STANDARD  ERROR  DETERMINED  FROM  THE  VARIANCE 
C 

0516  STD(J)-SQRT(-A(I,  n*A(LN,LN)/'DN)*TST(N5)/TSA 

051?  STDU)=AC(  N5  )>kFD*STD(J)>kVM/VRED 

C 

C  RELATI’VE  CONCENTRATION  IS  CONVERTED  TO  ACTUAL  CONCENTRATION  LEVEL 

C 

0518  2(:J)*(-A(I.LN))*(TST(N5)/TSA)>kAC(N5)»FD»VMA1?ED 

0519  844  CONTINUE 

C 

0520  846  LRITE  (MO. 922) 

0521  DO  84?  I«1.P 

0522  FPS-(2(n/STD(I))*5K2 

0523  ZPS-ZCI) 

0524  CALL  XQCALC(DN,FPS.ZPS,XF.QF.0) 

0525  RMSR  » A  ( LN .  LN )  -K  ( 1 . 0+FPS/DR )  /( DR+ 1) 

0526  URITE<MO.920)  TISOTC 1*2-1) .TISOT( I#2) ,Z( I) .STD( I) .FPS.QF.XF.RMSR 

052?  84?  CONTINUE 

C 

C  URITE  ANALYSIS  OF  VARIANCE  TA8LE 

C 

0523  XG-SG/DG 

0529  XR=SR/'DR 

0530  FF-XG/XR 

0531  URITE (MO. 924) HH 

0532  URITE(M0.925)HG.DG.SG.XG.FF 

0533  URITE(M0.925)HR.DR.SR.XR 

0534  URITE(M0.925)HT.DT.ST 

C 

C  COMPUTE  LLNL  R-STATISTIC 

C 

0535  CALL  RSTAT(NCH.P.R.N2.MF) 
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0536 

0537 

0538 

0539 

0540 

0541 

0542 

0543 

0544 

0545 

0546 

0547 

0548 

0549 

0551 

0552 

0553 

0554 

0556 

0557 

0559 

0560 

0561 

0562 

0563 

0564 

0565 

0566 

0567 

0568 


C 

C  COMPUTE  FINAL  STATISTICS  FOR  STANDARDS  ELIMINATED 

C  DURING  PIVOTAL  REGRESSION 

C 

iJRITEi:M0,935) 

DF=NCH-P-1 

J-0 

DO  850  I=*1,N 
N5“ISL(I) 

IN-D.AND.MY(N5) 

IFCIN)  350.850.848 

848  J-J+1 

TIS0T(J*2-1) »TISO( 1*2-1) 

TIS0T(J*2)=-TIS0(I*2) 

ZS-A(I.LN) 

INEG°0 

SQUC-A(I. I)*A(LN.LN) 

IF(SQUC.GT.0.0)  GO  TO  849 

SOUC— 1.0*SQUC 

INEG-1 

849  RHO-A(I.LN)/SQRT(SQUC) 

IFdNEG.EQ.  1)  RHO— 1.0*RHO 
R2-RH0**2 

IFCINEG.EQ.  1)  R2— 1.0*R2 
FPS-DF*R2/(1.0-R2) 

CALL  XQCALC(DN.FPS.2S.XF.QF,0) 

RMSR  =■  A  ( LN .  LN )  *  ( 1 . 0-R2 ) /DF 

IJRITE(MQ.933)  TIS0T(J*2-1) .TIS0T(J*2) .FPS.QF.XF.RHO.RMSR 

850  CONTINUE 

(JRITE  (MO, 926)  SNAM(  1) .SNAM(2) 

DO  851  II-l.NZ-1 
851  R(II)-0.0 

URITE  (M0.927)<R(J).J-1.MF) 

853  K*0 
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C 

C  FIND  SUSPICIOUS  CHANNELS.  THESE  ARE  DEFINED  AS  CHANNELS  WHERE 

C  STD/RESIDUAL  IS  GREATER  THAN  10  OR  WHERE  STD/RESIDUAL  IS  GREATER 

C  THAN  2  FOR  THE  CHANNELS  ON  EITHER  SIDE  OF  THE  ONE  CONSIDERED. 

C 


0570 

DO  870  J-NZ,N2 

0571 

T=ABS(R(Jn 

0572 

IF(T-10.)  860.860,866 

0573 

860 

IF>:R<:J-1)-2.0  )  870.862.862 

0574 

862 

IF(R(J)-2.0  )  870,864,864 

0575 

864 

IF(R(J+n-2.0  )  870.866,866 

0576 

866 

K-K+1 

0577 

IR(K)-J 

0578 

SIR(K)-R(J) 

0579 

IF(;<.GT.50)  GO  TO  872 

0581 

870 

CONTINUE 

0582 

872 

WRITE  (MO. 928) 

0583 

WRITE  (M0.929)(IR(I),SIR(I),I-1.K) 

0584 

CALL  RESIDCR.NZ.MF) 

0585 

CALL  RUNS(R.NZ.MF) 

0586 

IF(KRO.NE.l)  GO  TO  880 

0588 

DO  876  I-NZ,MF 

0599 

R(I)-R(I)*100+1000 

0590 

IF(R(I) .GT.2000.)  R<I)»2000. 

0592 

IFCRCn  .LT.0.)  R(n-0. 

0594 

876 

CONTINUE 

0595 

CALL  PUTCASC.R. IVAR.FILE.M) 

0596 

880 

GO  TO  895 

150 
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0614 

933  FORMAT < 

13X.'X-' 

0615 

934  FORMATC 

•  *  ■ 

0616 

935  FORMAT ( 

0617 

936  FORMAT ( 

I'PIVOT 

901  FCRMAT('  MX,  6 14) 

903  FORMAT  (2X.7F8.0) 

905  FORMATC'OMX.'UEIGHTED  SUMS  OF  STANDARDS  AND  UNKNOWN' ./'I 

906  FORMATCIX. 1PE11.4, 1PE11.4. 1PE11.4. 1PE11.4./) 

908  FORMAT  (1 ,40) 

909  FORMAT ':3A2.2X,  12.15.13.12,110.  5E10.3) 

912  FORMATdHl.'BACKGD  SUM-' .  1PE12.3, '  SAI*PLE  SUM-' .  1PE12.3./) 

921  FORMATS  ' .  IX. 'FIT-' ,  IPEl  1 .3) 

922  FORmT(lH0,'RESULTS-CONCENTRATIONS  AND  EST  STANDARD  ERRORS'./) 

926  FORMATdHl.'  RATIO  OF  RESIDUALS  OVER  STD  DEV  PER  CHANNEL  FOR'. 

927  FORMAT*  (1X.F7.1,  6F9.1) 

928  FORMATC 140, 'SUSPICIOUS  CHANNELS'./) 

929  FORMAT  (5( I4,2X.F5.2) ./) 

924  FORMATC 140. 12X.' ANALYSIS  OF  VARIANCE'/1X,2A4.6X, A4,4X.3(A4,7X) ) 
925  FORMAT(1X,A8.F11.0. 1P4E11.3) 

930  FORMATC  ' ,  14X.40('*' )/15X. '*' ,8X, 

1' STARTING  ANALYSIS  WITH' .SX, '*'/15X, '*' .5X, 

2' TRIAL  SET  -  BACKGROUND  ONLY' ,6X. '*'/15X. 

340 ( ' ♦' ) ) 

932  FORMAT ('  ',//////////////////////// 

1'  CALCULATED  PARTIAL  F-,Q-  AND  X-VALUES  TO  ADD:') 


890  WRITE (MO. 940) 

WRITE(7.940) 

940  FORMAT ('  NONE  OF  THE  CHOSEN  STANDARDS  RESULT'/ 
X'IN  A  SIGNIFICANT  CONTRIBUTION  TO  THE'/ 

X' BACKGROUND  SUBTRACTED  SAMPLE  SPECTRUM') 

095  WRITE(M0,896) 

896  FORMAT('l') 

897  CONTINUE 
END 
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MIDflS  FORTRAN  IV  STORAGE  MAP 


NAME 

OPPSET 

ATTRIBUTES 

A 

000006 

REAL*4 

ARRAY 

(10.10) 

Y 

000626 

REAL>M 

ARRAY 

(?13) 

Z 

004632 

REAL>M 

ARRAY 

(10) 

s 

004702 

REAL*4 

ARRAY 

(512) 

STD 

011702 

REAL*4 

ARRAY 

(10) 

B 

011752 

REAL>M 

ARRAY 

(10) 

R 

012022 

REAL*4 

ARRAY 

(512) 

U 

016022 

REAL«4 

ARRAY 

(512) 

IR 

022022 

INTEGER*2 

ARRAY 

(512) 

MY 

026022 

INTEGER*2 

ARRAY 

(10) 

FPM 

026046 

REAL*4 

ARRAY 

(10) 

FP 

026116 

REAL«4 

ARRAY 

(10) 

BA 

022022 

REAL«4 

ARRAY 

(512) 

SS 

026166 

REAL«4 

ARRAY 

(10) 

AC 

026236 

REALiM 

ARRAY 

(10) 

HA 

026306 

REAL«4 

ARRAY 

(10) 

IS 

026356 

INTEGER*2 

ARRAY 

(10) 

TST 

026402 

REAL*4 

ARRAY 

(10) 

HAT 

026452 

REAL*4 

ARRAY 

(10) 

TNAME 

026522 

LOGICAL*! 

ARRAY 

(36) 

TISOT 

026566 

REAL*4 

ARRAY 

(40) 

TISO 

027026 

REAL*4 

ARRAY 

(20) 

IT  - . 

027146 

INTEGER*2 

ARRAY 

(10) 

SNAM 

026530 

REAL«4 

ARRAY 

(2) 

ARR 

004702 

REAL*4 

ARRAY 

(10.64) 

HH  " 

027172 

REAL*4 

ARRAY 

(6) 

SIR 

027222 

REAL*4 

ARRAY 

(50) 

ISL- 

027532 

INTEGER*2 

ARRAY 

(10) 

HP 

027556 

REAL»a 

ARRAY 

(4) 

I  PORN 

027616 

INTEGER*2 

ARRAY 

(20) 

IPORKL 

027666 

INTEGER*2 

ARRAY 

(30) 

CC 

027762 

REAL*4 

ARRAY 

(10.10) 

ASC 

030602 

LOGICAL*! 

ARRAY 

(60) 

DEP 

030676 

LOGICAL*! 

ARRAY 

(10) 

EP 

030710 

LOGICAL*! 

ARRAY 

(10) 

HG 

030722 

REAL*8 

VARIABLE 

HR 

030732 

REAL*d 

VARIABLE 

HT 

030742 

REAL*8 

VARIABLE 

C 

034016 

INTEGER*2 

VARIABLE 

D 

034020 

INTEGER*2 

VARIABLE 

E 

030752 

INTEGER*2 

VARIABLE 

P 

034022 

INTEGER*2 

VARIABLE 

P 

034024 

INTEGER»2 

VARIABLE 

BR 

034026 

INTEGER*2 

VARIABLE 

BP 

034030 

INTEGER*2 

VARIABLE 

PILE 

034032 

INTEGER*2 

VARIABLE 

TISl 

030754 

REAL*4 

VARIABLE 

TIS2 

030760 

REAL*4 

VARIABLE 

I  DAT 

034034 

INTEGER*2 

VARIABLE 

I  VAR 

034036 

INTEGER*2 

VARIABLE 

MI 

034040 

INTEGER*2 

VARIABLE 

MIU 

034042 

INTEGER*2 

VARIABLE 

MO 

034044 

INTEGER*2 

VARIABLE 

I 

034046 

INTEGER*2 

VARIABLE 

NNN 

034050 

INTEGER*2 

VARIABLE 

IPO 

034052 

INTEGER*2 

VARIABLE 

NS 

034054 

INTEGER*2 

VARIABLE 

•VECTORED 


VECTORED 


VECTORED 


rilDftS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

M 

034056 

1NTEGER*2 

VARIABLE 

NIT 

034060 

INTEGER>t<2 

VARIABLE 

NBA 

034062 

INTEGER>K2 

VARIABLE 

NZ 

034064 

INTEGER)k2 

VARIABLE 

MF 

034066 

INTEGER*2 

VARIABLE 

TB 

034070 

REAL«4 

VARIABLE 

Q 

034074 

REAL«4 

VARIABLE 

NCH 

034100 

INTEGER*2 

VARIABLE 

JJ 

034102 

INTEGER»2 

VARIABLE 

J 

034104 

INTEGER*2 

VARIABLE 

GET 

000000 

REAL>i«4 

PROCEDURE 

FAT 

034106 

REAL>t<4 

VARIABLE 

II 

034112 

INTEGER*2 

VARIABLE 

K 

034114 

INTEGER*2 

VARIABLE 

NBR 

034116 

INTEGER*2 

VARIABLE 

NBS 

034120 

INTEGER*2 

VARIABLE 

TSA 

034122 

REAL*4 

VARIABLE 

VRED 

034126 

REAL*4 

VARIABLE 

DAV 

034132 

REAL*4 

VARIABLE 

VM 

034136 

REAL=«4 

VARIABLE 

FS 

034142 

REAL>t<4 

VARIABLE 

FX 

034146 

REAL*4 

VARIABLE 

SB 

034152 

REAL*4 

VARIABLE 

SI 

034156 

REAL^M 

VARIABLE 

S2 

034162 

REALiM 

VARIABLE 

NB 

034166 

INTEGER*2 

VARIABLE 

N(/ 

034170 

INTEGER5K2 

VARIABLE 

N 

034172 

INTEGER*2 

VARIABLE 

F0 

034174 

REAL»4 

VARIABLE 

LU 

034200 

INTEGER*2 

VARIABLE 

NEUST 

034202 

INTEGER>t«2 

VARIABLE 

KRO 

034204 

INTEGER*2 

VARIABLE 

NDET 

034206 

INTEGER>tc2 

VARIABLE 

LN 

034210 

INTEGER*2 

VARIABLE 

T 

034212 

REAL>K4 

VARIABLE 

SUMU 

034216 

REAL#4 

VARIABLE 

L 

034222 

INTEGER*2 

VARIABLE 

N5 

034224 

INTEGER*2 

VARIABLE 

N6 

034226 

INTEGER*2 

VARIABLE 

SA 

034230 

REAL»4 

VARIABLE 

ST 

034234 

REAL>M 

VARIABLE 

MZ 

034240 

INTEGER5K2 

VARIABLE 

NF 

034242 

INTEGER*2 

VARIABLE 

SRDl 

034244 

REAL«4 

VARIABLE 

SRD2 

034250 

REAL*4 

VARIABLE 

SORT 

000000 

REAL*4 

PROCEDURE 

LSK 

034254 

INTEGER*2 

VARIABLE 

KAC 

034256 

INTEGER*2 

VARIABLE 

PIVOT 

000000 

REAL»<4 

PROCEDURE 

FPS 

034260 

REAL*4 

VARIABLE 

FMIN 

034264 

REAL*4 

VARIABLE 

IN 

034270 

INTEGER*2 

VARIABLE 

DF 

034272 

REAL*4 

VARIABLE 

ZS 

034276 

REAL«4 

VARIABLE 

XQCALC 

000000 

REAL*4 

PROCEDURE 

XF 

034302 

REAL>t«4 

VARIABLE 

OF 

034306 

REAL«4 

VARIABLE 

niDAS 

FORTRAN  : 

[V  STORAGE  MAP 

NAME 

OFFSET 

ATTRIBUTES 

JDF 

034312 

INTEGER*2 

VARIABLE 

FMAX 

034314 

REAL>K4 

VARIABLE 

INEG 

034320 

INTEGER*2 

VARIABLE 

SQUC 

034322 

REALM 

VARIABLE 

RHO 

034326 

REALM 

VARIABLE 

R2 

034332 

REALM 

VARIABLE 

RMSR 

034336 

REALM 

VARIABLE 

RSS 

034342 

REALM 

VARIABLE 

SG 

034346 

REALM 

VARIABLE 

CH 

034352 

REALM 

VARIABLE 

VY 

034356 

REALM 

VARIABLE 

VU 

034362 

REALM 

VARIABLE 

VW 

034366 

REALM 

VARIABLE 

JJJ 

034372 

INTEGER5K2 

VARIABLE 

V 

034374 

REALM 

VARIABLE 

LOOP 

034400 

INTEGER5K2 

VARIABLE 

RE 

034402 

REALM 

VARIABLE 

TMO 

074406 

REALM 

VARIABLE 

ABS 

000000 

REALM 

PROCEDURE 

TMP 

034412 

REALM 

VARIABLE 

RT 

034416 

REALM 

VARIABLE 

TE 

034422 

REALM 

VARIABLE 

SR 

034426 

REALM 

VARIABLE 

DN 

034432 

REALM 

VARIABLE 

DR 

034436 

REALM 

VARIABLE 

DG 

034442 

REALM 

VARIABLE 

DT 

034446 

REALM 

VARIABLE 

CHDF 

0344S2 

REALM 

VARIABLE 

FD 

034456 

REALM 

VARIABLE 

EXP 

000000 

REALM 

PROCEDURE 

2PS 

034462 

REALM 

VARIABLE 

XG 

034466 

REALM 

VARIABLE 

XR 

034472 

REALM 

VARIABLE 

FF 

034476 

REALM 

VARIABLE 

RSTAT 

000000 

REALM 

PROCEDURE 

N2 

034502 

INTEGERJIC 

VARIABLE 

BPc;.Tn 

joamsuL 

PRnrpmiQP 

RUNS 

000000 

REALM 

PROCEDURE 

PUT 

000000 

REALM 

PROCEDURE 

iiHCmiMi  ■I.KK  /H/  LENGTH  080884 

FUD  000000  REflL*4  VARIABLE 


ND  6600 

LINKER 

V02-P-1 

LOAD  MAP 

5  OCT  1983 

1:43; 12  PM 

SECTION 

PDDR 

SIZE 

ENTRY 

PDDR 

ENTRY 

PDDR 

ENTRY 

PDDR 

.  P)BS. 

000000 

000000 

SLRECL 

000210 

SNLCHN 

000006 

SUSRSU 

000000 

$RF1B3 

000000 

.  PBS. 

000000 

000000 

SSYSLB 

000000 

.  PBS. 

000000 

000000 

STRPCE 

004737 

.  PBS. 

000000 

000000 

$V004P 

000001 

.$S$$.8i 

020000 

000000 

.SSSS. 

020000 

X  & 

020000 

000004 

X 

020000 

020004 

053706 

073712 

001066 

PIVOT 

073712 

075000 

001060 

RSTPT 

075000 

076060 

000624 

XQCALC 

076060 

076704 

000552 

GET 

076704 

077456 

000614 

PUT 

077456 

100272 

001364 

RES  ID 

100272 

101656 

001342 

RUNS 

101656 

103220 

000772 

HISTO 

103220 

104212 

000106 

CONCPT 

104212 

104320 

000060 

NMISII 

104320 

NMISMI 

104346 

NIilSPI 

104354 

NPISII 

104364 

NPISMI 

104370 

NPISPI 

104374 

104400 

000044 

NMISIP 

104400 

NPISII 

104420 

NPISIM 

104432 

NPISIP 

104414 

104444 

000142 

SORT 

104444 

104606 

000350 

EXP 

104606 

105156 

000262 

XFIS 

105156 

SPUR  I 

105156 

105440 

000110 

TPDS 

105470 

TAFS 

105476 

TAIS 

105440 

TPLS 

105446 

TAPS 

105462 

TAOS 

105454 

105550 

000056 

SOTIS 

105550 

105626 

000210 

ISNS 

105626 

LSNS 

105646 

SISNTR 

105632 

SLSNTR 

105652 

106036 

000034 

ENDS 

106036 

ERRS 

106054 

106072 

000046 

EOLS 

106072 

106140 

000044  RETS 

106154 

RETSF 

106144  RETSI 

106152 

RETSL 

106140 

106204 

001106 

IBRS 

106212 

I  BUS 

106204 

SIBU 

106216 

107312 

000072 

ENCS 

107312 

107404 

000020 

IFRS 

107404 

IFUS 

107416 

107424 

001562 

SFIO 

110112 

111206 

002344 

DCOS 

1 12632 

ECOS 

1 12624 

FCOS 

1 12620 

GCOS 

112612 

ICIS 

111214 

I  COS 

1 12366 

OCIS 

1 1 1206 

OCOS 

1 12360 

RCIS 

111410 

SGET 

1 1 1374 

1 13552 

000110 

SDUrPL 

1 13552 

1 13662 

000036 

SGETFI 

1 13662 

113720 

000042 

DIISIS 

113732 

DIISMS 

1 13726 

D I ISPS 

113720 

DIISSS 

113734 

SDVI 

1 13734 

1 13762 

000040 

MUISIS 

1 13774 

nuisMS 

1 13770 

MU  ISPS 

113762 

MUISSS 

1 13776 

SM.I 

113776 

114022 

000130 

CICS 

114022 

CIDS 

114022 

CIFS 

114032 

CILS 

114144 

CLCS 

114022 

CLDS 

114022 

CLFS 

114032 

CL  IS 

114150 

SDI 

114022 

SRI 

114032 

r 


1U152 

114272 


114336 

114340 

114440 

114452 


000120 

000044 


000002 

000100 

000012 

000026 


114500  000026 


114526 

114572 

114622 

114636 

114674 

114712 


000044 

000030 

000014 

000036 

000016 

000102 


115014  000046 


115062  000044 


115126  000034 


115162  000046 


115230  000044 


1 15274  000046 


115342  000044 


115406  000064 


115472  000174 


SFCHHL 

BEQ$ 

BLE$ 

BRB$ 

$A0TS 

CCI* 

SIC 

SUAIT 

SALS IP 

SVLSIP 

SALSIM 

SVLSIM 

JMCS 

ANDS 

XQRS 

A  IPS 

CAIS 

ABS 

MOISIA 

MOISMA 

hOISSA 

MOIS0A 

noisiA 

MOLSIS 

CMISIP 

CMISPM 

CMIS3P 

CMISII 

CMISMI 

CMISSI 

DC  ISA 

DCISS 

ICISP 

SUISIP 

SUISPM 

SUISSP 

SUISIA 

SUISKA 

SUISSA 

ADISIP 

ADISPM 

ADIS5P 

ADISIA 

ADISMA 

ADISSA 

MOISIP 

MOISPM 

flOISSP 

CMFSII 

CrFSIS 

CrFSMP 

CMFSPM 

CMFSSI 

CMFSSS 


114152 
! 14312 
114310 
114324 
114336 
114340 
114340 
IIAa40 
114452 
114460 
1 14500 
114506 
114534 
114576 
114606 
114622 
114636 
114674 
114736 
114752 
114722 
114766 
115006 
1 14726 
115014 
1 15054 
115016 
115102 
115116 
1 15066 
115156 
115144 
115136 
115162 
115214 
115164 
1 15250 
1 15264 
1 15234 
1 15274 
1 15326 
1 15276 
1 15362 
115376 
115346 
115406 
115440 
115410 
115546 
115512 
1 15570 
115614 
1 15552 
1 15520 


BGES 

BLTS 

NMISII 


SALa>P 

SVLSMP 

SALSm 

SVLSMM 

JMISM 

EQVS 


114322  BGTS 
114332  BMES 
114302  NMISIM 

114340  CFIS 
114340  SIR 

114470  SALSSP 
114474  SVLSSP 
114516  SALSSM 
114522  SVLSSM 
114530  JMISP 
114604  lORS 


MOISIM 

MOISMM 

MOISSM 

MOiseri 

MOISIM 

MOLSSS 

CMisrp 

CMISPP 

CMISIM 

CMISMM 

CMISSM 

DCisri 

ICISA 

ICISS 

SUISMP 

SUISPP 

SUISIM 

SUISMM 

SUISSM 

ADISMP 

ADISPP 

ADISIM 

ADISMM 

ADI^M 

MOIS^F 

MOISPP 

MOIS0P 

CMFSIM 

CMFSMI 

CMFSMS 

CMFSPP 

CMFSSM 

scrs? 


114644 

114732 
114746 
114716 
1 14762 
115000 
114712 
115024 
115034 

115106 

115122 

115072 

115150 

115140 

115126 

115176 

115172 


MOISIS 
MOISMS 
MOISSS 
MO  ISOS 
MOISIS 
RELS 
CMISPI 
CM ISPS 

CMISIS 
CMISMS 
CMIS6S 
DC  ISP 
ICISM 

SUISPA 

SUISPS 


115254  SUISI5 
115270  SUISMS 
115240  SUISS5 
115310  ADISPA 
115304  AD  ISPS 


1 15366 
115402 
1 15352 
1 15422 
115416 
1 15454 
115630 
115536 
115476 
1 15564 
1 15634 
115520 


ADISI5 
ADISMS 
ADISSS 
MOISPA 
MO  ISPS 
MOISIP 
CMFSIP 
CMFSMM 
CMFSPI 
CMFSPS 
CMFSSP 


1 14320 
1 14330 
114272 

114354 

114354 

114454 
114462 
1 14502 
114510 
114526 
1 14572 


1 14726 
1 14742 
114712 
1 14756 
114772 
114726 
115046 
115040 

115076 

115112 

115062 

115154 

115132 

1 15222 
1 15206 

115244 
1 15260 
1 15230 
1 15334 
115320 

115356 
1 15372 
1 15342 
115446 
115432 
115462 
1 15600 
1 15620 
115532 
115472 
115604 


Ea» 


115666  000116  HOL$I0 
MOLSMfl 
nOL*MS 
MOLSPP 
MOL$SM 

116004  000026  hOFSRP 
MOFSRS 

116032  000012  MOFSSS 
116044  000014  MOFSIS 
116060  000016  MOF$NS 
116076  000014  nOFSSR 
116112  000010  MOFSIR 
116122  000014  MOFSSM 
116136  000020  MOFSin 
116156  000020  riOF$0R 
116176  000042  MQFSnR 
MOF$PR 

116240  000054  SRISPh 
SVISPP 

116314  000032  SRISIP 
SVISIP 

116346  000032  SRISIM 
SVIJIM 

116400  000032  TSDSI 
TSD*S 
TSFSP 
TSISM 

116432  000034  CPDSSn 
CPLSSM 

116466  000030  LEGS 
LLE$ 

116516  000024  TSLSI 
TSL$S 

116542  000044  SRFSIP 
SVFSIP 

116606  000044  SRFSin 
SVFSIM 

116652  000036  NGD$R 
NGD$S 
NGF$P 

116710  000044  SRDSIM 
SVPSIM 

116754  000030  nODSMS 
MODSVS 

LUND  117004  000054  LUNOEF 
CLOSU  117060  000032  CLOSEU 
JM.TVT  117112  000062  TVD* 

TVL$ 

OT  117174  001510  $ERR$S5 

STOP  120704  000112  EXIT 
RIO  121016  000600  DEF$ 

*GETIN 

GETREC  121616  000346  SGETRE 
EHDFIL  122164  000042  EOF$ 


115766  MOL$IM  115760  MOLSIP  115774 

115712  MOLSTIM  115706  MOLSMP  115730 

115676  MOLSPfi  115752  MOLSPM  115740 

115724  rt:L*PS  115746  IICLfSR  115672 

115666  MOLSSP  115716 

116022  MOFJRM  116012  MOFSRP  116026 

116004 
116032 

116044  MOF$0S  116052 
116060  MOFSPS  116072 
116076 
116112 

116122  MOFSSP  116132 

116136  MOFSIP  116150 

116166  MOF$0M  116156  MOF*0P  116172 

116210  MOF$MM  116176  MOFSMP  116216 

116230  MOF«’M  116224  MOFSPP  116234 

116240  SRISPP  116266  SVI$Pt1  116252 

116300 

116314  SRI$HP  116336  SRISSP  116316 
116324  SVI$MP  116342  SVISSP  116326 
116346  SRIJMM  116370  SRI*SM  116350 
116356  SVI$W  116374  SVISSM  116360 
116420  TSDS1  116414  TSDSP  116424 
116404  TSFSI  116420  TSFSM  116414 
116424  TSFSS  116410  TSISI  116420 
116414  TSISP  116424  TSISS  116400 
116454  CPFSSM  116442  CPISSM  116436 
116432 

116470  LGE$  116500  LGTS  116476 
116466  LLT*  116512  LNE*  116510 
116526  TSLSn  116522  TSL$P  116534 
116516 

116542  SRFS7P  116576  SRF$SP  116544 
116554  SVFSMP  116602  SVFSSP  116556 
116606  SRF$M1  116642  SRFSSti  116610 
116620  SVF*m  116646  SVF$SM  116622 
116704  NGDS1  116664  NGDSP  116700 
116652  NGFSfl  116704  NGFSM  116664 
116700  NGF^  116652 
116710  SRD$MM  116744  SRDSSM  116712 
116724  SVDSMM  116750  SVDSSM  116726 
116764  MODSPS  116760  MODSSS  116754 
116766 
1 17004 
1 17060 

117126  TVF$  117120  TVI$  117150 
117112  TVPS  117142  TVQS  117134 
117704  JFPERR  117546  $OTI  117174 
120730  F00$  120704  STP$  120730 

121532  IRR$  121016  IRUS  121022 
121402 

121616  STTYIN  122116 
122164 


157 


LuwiS  122226  000550  SCLOSE  122226 

OUTREC  122776  000414  SPUTRE  1?2776 

$ri.FI0  123412  000216  SFMTDR  123412  JFMTDU  123446  $INITI  123520 

OPEN  123630  000610  *OPEN  123630 

FADD  124440  000062  ADFSIS  124440  ADFSMS  124452  ADFSPS  124446 

ADFSSS  124444  SUFSIS  124466  SUFSMS  124500 

SUFSPS  124474  SUFSSS  124472  SADR  124444 

$SBR  124472 

FDIV  124522  000034  DIFSIS  124540  DIF*MS  124526  DIFSPS  124522 

DIFSSS  124544  $DVR  124544 

FMUL  124556  000034  MUFSIS  124574  MUFSMS  124562  MUFSPS  124556 

MUFSSS  124600  $MLR  124600 

RUBLK  124612  000460  SEOFIL  125222  SGETBL  125034  SPUTBL  124612 

ERRTB  125272  000100  $ERRTB  125272 

ERRS  125372  002570  SERRS  125372 

SM.LCV  130162  000106  LCI$  130162  LCDS  130230 

ADDM  130270  000116  ADF$IM  130270  ADFSTtl  130302  ADFSPtI  130276 

ADF*Sri  130312  SUF5IM  130326  SUFSW  130362 

SUFSPM  130356  SUFSSM  130334 

ADDP  130406  000114  ADFSIP  130406  ADFSMP  130420  ADF$PP  130414 

ADFSSP  130430  SUFSIP  130444  SUF$f1P  130500 

SUFSPP  130474  SUFSSP  130452 

ADDA  130522  000150  ADFSIA  130522  ADFSMA  130554  ADFSPA  130550 

ADFSSA  130532  SUFSIA  130600  SUFSMA  130634 

SUF*PA  130630  SUF*SA  130606  SFPAR  130574 

$FPSR  130654 

SM.LNO  130672  000022  COISS  130672  COLSA  130702  COLSM  130676 

COL$P  130706  COLJS  130672 

m 

SEGMENT  PARAMETER  TABLE 

SEG  SIZE  LIMIT 
0  110T14  130714 

PROGRAM  SIZE  ;  110714 
DATA  AREA  SIZE  -  000000 
TRANSFER  ADDRESS  -  020004 
STACK  SIZE  -  001000 
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0001 

C 

n 

SUBROUTINE  HISTO(LABEL. IH.XL.XD,N) 
URITTEN  BY  G. PH  ILL  IPS  JUNE  1981 

0002 

L 

REAL*8  LABEL (4) 

0003 

LOGICAL*!  A(50),ASTAR,ACOLON 

0004 

DIMENSION  IH(21) 

0005 

DATA  A/Se^lH*/, lOUT/S/ 

0006 

DATA  ASTAR/'1H*/'.ACQL0N/1H:/ 

0007 

L 

MAX-0 

0008 

DO  200  K-l.N 

0009 

200 

IFCMAX.LE. IH(K))  MAX»IH(K) 

0011 

IDIV-1 

0012 

L-5 

0013 

250 

IF(MAX/IDIV.LE.50)  GO  TO  300 

0015 

IDIV-IDIV*2 

0016 

IF(IDIV.LT.L)  GO  TO  250 

0018 

IDIV-L*2 

0019 

L-L*10 

0020 

GO  TO  250 

0021 

300 

IDELT-IDIV/2 

0022 

LIRITE(IOUT,310)  LABEL 

0023 

310 

FORMAT(1H1.4A0) 

0024 

UR  I TE( I OUT. 3201  IDIV 

0025 

320 

FORMAT(1H0, ’SCALE  FACTOR-* , 16/) 

0026 

X-XL 

0027 

‘IT-0 

0028 

DO  400  K-1,N 

0029 

IT-IT+IH(K) 

0030 

J-<IH(K)+IDELT)/IDIV 

0031 

IF(J.LT. 1)  A(1)-AC0L0N 

0033 

UR  I TE( I OUT. 360)  X. IH<K) . <A( I) , I-l. J) 

0034 

360 

FORMATC lX.Gl 1 .3. I0.2X.50A1) 

0035 

A(1)-ASTAR 

0036 

X-X+XD 

0037 

400 

CONTINUE 

0038 

URITE(IOUT.410)  IT 

0039 

410 

FORMAT<1H0.4X.’ TOTAL  -’.18) 

0040 

DO  500  1-1.5 

0041 

500 

URITE(IOUT.510) 

0042 

510 

FORMAT (1H0) 

0043 

RETURN 

0044 

END 

10038 

IF (RE  1 . LT . 0 , ) RE  1 -32768 . +RE 1 

0040 

IF (RE 1 . GE . 16384, ) RE  1 -RE  1- 16384. 

0042 

ARRA Y ( K ) -RE  1 *65536 . +RE2 

0043 

100 

CONTINUE 

0044 

K-M+1 

0045 

END  FILE  FILE 

0046 

200 

M-K-1 

0047 

RETURN 

0048 

END 

159 


MIDAS  FORTRAN  IV  STORAGE  MAP 

.  I 


NAME 

OFFSET 

ATTRIBUTES 

LABEL 

000014 

REAL>K8 

PARAMETER 

ARRAY 

(4) 

A 

000026 

LOGICAL*! 

ARRAY  (50) 

IH 

000016 

INTEGER*2 

PARAMETER 

ARRAY 

(21) 

XL 

000020 

REAL*4 

PARAMETER 

VARIABLE 

XD 

000022 

REALM 

PARAMETER 

VARIABLE 

N 

000024 

INTEGER*2 

PARAMETER 

VARIABLE 

ASTAR 

000112 

LOGICAL*! 

VARIABLE 

ACOLON 

000113 

LOGICAL*! 

VARIABLE 

I  OUT 

000110 

INTEGER*2 

VARIABLE 

MAX 

000210 

INTEGER*2 

VARIABLE 

K 

000212 

INTEGER*2 

VARIABLE 

ID  IV 

000214 

INTEGER*2 

VARIABLE 

L 

000216 

INTEGER*2 

VARIABLE 

IDELT 

000220 

INTEGER*2 

VARIABLE 

X 

000222 

REAL*4 

VARIABLE 

IT 

000226 

INTEGER*] 

VARIAOLE 

J 

000230 

INTEGER*2 

VARIABLE 

I 

000232 

INTEGER*] 

VARIABLE 

aa«]|4 

ReAL>M 

VARIRfLI 

RE] 

610338 

RBALiM 

VARIAILI 

CO^tQN  BLOCK  /HKAD>  LENGTH  eaei4a 

IHDR 

000000 

INTEGER*2 

VARIABLE 

TITLE 

000002 

INTEGER*2 

ARRAY  (32) 

ID 

000102 

INTEGER*] 

ARRAY  (8) 

ELTIME 

000122 

REAL*4 

VARIABLE 

PLTIME 

000126 

REAL*4 
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0001 

SUBROUTINE  PIVOT(A.P,E.K) 

L 

c 

p 

URITTEN  BY:  G.  U.  PHILLIPS  AND  B.  G.  GLAGOLA  JULY, 1982 

L 

c 

p 

REFERENCE:  M.  J.  GARSIDE,  APPL.  STAT.  20(1971)  lll-li; 

8002 

INTEGER  P1,P2,P 

0003 

REAL  AC  10, 10) 

0004 

LOGICAL*!  EC  10) 

c 

DIMENSION  N  MUST  BE  GREATER  THAN  OR  EQUAL  K. 

c 

ARRAY  E  MUST  BE  INITIALIZED  ".FALSE."  BEFORE 

c 

p 

FIRST  CALL  TO  PIVOT. 

0005 

L 

AA-1.0/'A(P,P) 

0006 

A(P.P)*-AA 

0007 

P1=»P-1 

0008 

P2=*P+1 

0009 

IFCP.EQ.l)  GO  TO  350 

0011 

DO  300  I-1,P1 

0012 

AIP=A(I.P)*AA 

0013 

DO  100  J-I,P1 

0014 

A(I.J)»A(I,J)-AIP*A(J,P) 

0015 

100 

CONTINUE 

0016 

DO  200  J=P2,K 

0017 

ACI.J)=A(I.J)-AIP*A(P,J) 

0018 

200 

CONTINUE 

0019 

A(I,P)-  -AIP 

0020 

IFCECP))  AC^Pl-AIP 

0022 

300 

CONTINUE 

0023 

350 

DO  500  I-P2,K 

0024 

AIP-ACP, I)*AA 

0025 

DO.  400  J-I,K 

0026 

A(I.J)-A(I,J)-AIP*A(P,J) 

8027 

400 

CONTINUE 

0028 

ACP,  D— AIP 

0029 

IFCECP))  A(P,I)-AIP 

0031 

500 

CONTINUE 

0032 

E(P)-.NOT.E(P) 

0033 

RETURN 

0034 

END 

0038 

IF(REl.LT.0.)REl-32768.+REl 

0040 

IFCREl.GE. 16384.) RE 1»RE 1-16384. 

0042 

ARRAY ( K ) »RE 1 *65536 . +RE2 

0043 

100 

CONTINUE 

0044 

K-M+1 

NRL 


<r  Ul  CL  Q. 
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NAME 

OFFSET 

ATTRIBUTES 

A 

000014 

ftEAL«4 

PARAMETER 

ARRAY 

(10,10)  VECTORED 

E 

000020 

LOGICAL*! 

PARAMETER 

ARRAY 

(10) 

P 

000016 

INTEGER*2 

PARAMETER 

VARIABLE 

K 

008022 

INTEGER*2 

PARAMETER 

VARIABLE 

PI 

000050 

INTEGER*2 

VARIABLE 

P2 

000052 

INTEGER*2 

VARIABLE 

AA 

000054 

REAL*4 

VARIABLE 

I 

000060 

INTEGER*2 

VARIABLE 

AIP 

000062 

REAL>K4 

VARIABLE 

J 

000066 

INTEGER*2 

VARIABLE 

I 

i 
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0001 

C 

r 

SUBROUTINE  GETCRSC.RRRRY, IVRR.FILE.M) 

LAST  MODIFIED  OCTOBER  1982  BY  G.U.P. 

0002 

w 

C0MM0N/HEAD/IHDR.TITLE(32),ID(3),ELTIME.PLTIME,ERTIME,PRTIME 

0003 

INTEGER*2  TITLE. ID 

0004 

DIMENSION  RRRRYC256),ITIME(4) 

0005 

LOGICAL#!  RSC(60),DEFC10),NAM(60) 

0006 

INTEGER  PILE 

000? 

DEFINE  FILE  FILE(0,2.U. IVRR) 

0008 

ENCODECS, 10.DEF)FILE 

0009 

10 

FORMRTC'DEF  ',12.'.  ') 

0010 

DEF(9)».FALSE. 

0011 

DEF( 10) -.FALSE. 

0012 

CALL  C0NCATt:DEF.ASC,NAM,59) 

0013 

CALL  LUNDEF(NAM.E) 

0014 

IVAR-12 

0015 

DO  12  1-1.4 

0016 

12 

READCFILE' IVARIMLT. ITIME( I) 

0017 

PLTirt-ITIMECU 

0018 

ELTIME-ITIME(2) 

0019 

PRTIME-ITIMECS) 

0020 

ERTIME-ITIME(4) 

0021 

I VAR -84 

0022 

DO  20  1-1.31.2 

0023 

20 

READCFILE' IVAR) TITLEC D .TITLEC I+l) 

0024 

DO  30  1-1.7. 2 

0025 

30 

READCFILE'  IVAR)  IDCD,  IDCI+l) 

0026 

IHDR-1 

0027 

I VAR -28 

0028 

READCFILE' IVAR)A0 

0029 

READCFILE' IVAR)B0 

0030 

■ 

READCFILE' IVAR)C0 

0031 

I VAR- 193 

0032 

DO  100  K-1,M 

0033 

READCFILE' I VAR, END -200) MSB. LSB 

0034 

RE  1 -MSB 

0035 

RE2-LSB 

0036 

IFCRE2.LT.0. )RE2 -65536. +RE2 

0038 

IFCREl.LT.0.)REl-32768.+REl 

0040 

IFCREl.GE. 16384. ) RE  1 -RE  1-16334. 

0042 

ARRAYCK) -RE  1 #65536. +RE2 

0043 

100 

CONTINUE 

0044 

K-M+1 

0045 

END  FILE  FILE 

0046 

200 

M-K-1 

0047 

RETURN 

niDflS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

ARRAY 

000016 

REAL>M 

PARAMETER  ARRAY 

(256) 

ITIME 

000026 

INTEGER>K2 

ARRAY  (4) 

ASC 

000014 

LOGICAL*! 

PARAMETER  ARRAY 

(60) 

DEF 

000036 

LOGICAL*! 

ARRAY  (10) 

NAM 

000050 

LOGICAL*! 

ARRAY  (60) 

I  VAR 

000020 

INTEGER*2 

PARAMETER  VARIABLE 

FILE 

000022 

INTEGER*2 

PARAMETER  VARIABLE 

M 

000024 

INTEGER*2 

PARAMETER  VARIABLE 

CONCAT 

000000 

REAL*4 

PROCEDURE 

LUNDEF 

000000 

INTEGER*2 

PROCEDURE 

E 

000172 

REAL*4 

VARIABLE 

I 

000176 

INTEGER*2 

VARIABLE 

MLT 

000200 

INTEGER*2 

VARIABLE 

AO 

000202 

REAL*4 

VARIABLE 

B0 

000206 

REAL*4 

VARIABLE 

00 

000212 

REAL*4 

VARIABLE 

K 

000216 

INTEGER*2 

VARIABLE 

MSB 

000220 

INTEGER*2 

VARIABLE 

LSB 

000222 

INTEGER*2 

VARIABLE 

REl 

000224 

REAL*4 

VARIABLE 

RE2 

000230 

REAL*4 

VARIABLE 

COMMON 

BLOCK  /HEAD/  LENGTH  000142 

IHDR 

000000 

INTEGER*2 

VARIABLE 

TITLE 

000002' 

INTEGER*2 

ARRAY  (32) 

ID 

000102 

INTEGER*2 

ARRAY  (8) 

ELTIME 

000122 

REAL  *4 

VARIABLE 

PLTirC 

000126 

REAL*4 

VARIABLE 

ERTIME 

000132 

REAL*4 

VARIABLE 

PRTIME 

000136 

REAL*4 

VARIABLE 

MIDftS  FORTRAN  IV 
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V.' 

C 


0001 

C 

p 

SUBROUTINE  PUT(ASC. ARRAY. IVAR.FILE.M) 
URITTEN  BY  G.  PHILLIPS,  JUNE  1981 

0002 

DIMENSION  ARRAY(256) 

0003 

LOGICAL*!  ASC (60) , DEF( 10) .NAM(60) 

0004 

INTEGER  FILE 

0005 

DEFINE  FILE  FILE(44a,2.U. IVAR) 

0006 

ENCODE(a. 10,DEF)FILE 

0007 

10 

FORMAT('DEF  '.12.'.  ') 

0008 

DEF(9)-.FALSE. 

0009 

DEF( 10) -.FALSE. 

0010 

CALL  C0NCAT(DEF,ASC.NAM.59) 

0011 

CALL  LUNDEF(NAM.E) 

0012 

IVAR- 193 

0013 

DO  100  K-l.M 

0014 

V-ARRAY(K) 

0015 

IF(V.LT.0.)  V-0. 

0017 

IF (V.LT. 65536.)  GOTO  50 

0019 

V-V/'65536. 

0020 

IFCV.GT. 16383.)  V-163a3. 

0022 

MS8-V 

0023 

LSB-0 

0024 

GOTO  80 

0025 

50 

IFCV.GT. 32767.)  V-V-65536. 

0027 

LSB-V 

0028 

MSB-0 

0029 

80 

URITECFILE' IVAR)MSB,LSB 

0030 

100 

CONTINUE 

0031 

END  FILE  FILE 

0032 

CALL  CLOSEU(FILE) 

0033 

RETURN 

0034 

END 

A0038 

IF(REl.LT.0.)REl-32768.+REl 

0040 

I F  (RE  1 .  GE .  16384-. )  RE  1  -RE  1- 1 6384. 

0042 

ARRAY ( K ) -RE  1 *65536 . +RE2 

0043 

100 

CONTINUE 

0044 

K-M+1 

0045 

END  FILE  FILE 

0046 

200 

M-K-1 

0047 

RETURN 

0048 

END 

MIDAS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

ARRAY 

000016 

REAL>K4 

PARAMETER 

ARRAY 

(256) 

ASC 

000014 

L0GICAL>K1 

PARAMETER 

ARRAY 

(60) 

DEF 

000026 

LOGICAL*! 

ARRAY  (10) 

NAM 

000040 

LOGICAL*! 

ARRAY  (60) 

I  VAR 

000020 

INTEGER*2 

PARAMETER 

VARIABLE 

FILE 

000022 

INTEGER*2 

PARAMETER 

VARIABLE 

M 

000024 

INTEGER*2 

PARAMETER 

VARIABLE 

CONCAT 

000000 

REAL*4 

PROCEDURE 

LUNDEF 

000000 

INTEGER*2 

PROCEDURE 

E 

000172 

REAL*4 

VARIABLE 

K 

000176 

INTEGER*2 

VARIABLE 

V 

BBoaea 

REALM 

VARIABLE 

MSB 

I!e02a4 

INTBGER»a 

VAR t ABLE 

LSB 

aB02B6 

INTEGER»2 

VARIABLE 

aosEU 

BBBBBB 

REALM 

PROCEDURE 

aetase 

INTEGERW2  VARIABLB 

P2 

000052 

INTEGER*2 

VARIABLE 

AA 

000054 

REAL*4 

VARIABLE 

I 

000060 

INTEGER*2 

VARIABLE 

AIP 

000062 

REAL*4 

VARIABLE 

J 

000066 

INTEGER*2 

VARIABLE 

MIDfiS 
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001 

0001 

C 

c 

SUBROUTINE  RESIDCR.NZ.MF) 

URITTEN  BY  G. PHILLIPS  JUNE  1981 

0002 

w 

DIMENSION  R(2561.A(4),C(4).IH(21) 

0003 

REAL>t<8  LABEL  (4) 

0004 

DATA  I  OUT/'S/ 

0005 

n 

DATA  LABEL/8H  DIST.8HRIBUTI0N.SH  OF  RESI,8HDUALS 

0006 

U 

DO  100  K-U21 

0007 

100 

IH(K)-0 

0008 

DO  150  J-1.4 

0009 

150 

C(J)-0. 

0010 

DO  200  I-N2.MF 

0011 

DO  180  J*1.4 

0012 

180 

C(J)=C(J)+R(n»5Kj 

0813 

K-R<D*2.  +  11.5 

0014 

IF<K.GT.21)  K-21 

0016 

IF(K.LT.l)  K-1 

0018 

IH(K)-IHCK)+1 

0019 

200 

CONTINUE 

0020 

M-MF-NZ+1 

0021 

DO  220  J-1.4 

0022 

220 

C(J)-C(J)/M 

0023 

U-C(D 

0024 

A(l)-U 

0025 

U2=U*U 

0026 

U3-U#U2 

0027 

U4-U*U3 

0028 

V-C(2)-U2 

0029 

A(2)-V 

0030 

A  (31  -C  <  3)  -35(4J*C  (2)  +2i*«U3 

0031 

A (4) -C (4) -4»U*C (3) +6*U2*C (2) -3*U4 

0032 

SD-SQRT(V1 

0033 

Sa-A<3)/SDw*3 

0034 

D 

EX-A(4)/V5Mt2-3, 

URITECIOUT. 1000)M. (I,A(I),C<I).I-1,4) 

D1000 

FORMAT(lH0.'NUr«ER  OF  ELEMENTS  -'.14/ 

D 

1  (I5,2G11.3)) 

0035 

IJRITE(IOUT.300)U.V.SQ.EX 

0036 

300 

FORMAT(1H0.'MEAN  RESIDUAL  -',F8.3,'.  VARIANCE  •* , 
1  SKEUNESS  -'.Gll.S,'.  EXCESS  -'.Gil. 3) 

F8. 

0037 

XL— 5.0 

0038 

XD-0.5 

0039 

N-21 

0040 

CALL  HISTOCLABEL. IH.XL.XD.N) 

0041 

RETURN 

MIDflS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

R 

000014 

REAL>k4 

PARAMETER 

ARRAY  (256) 

A 

000022 

REAL>K4 

ARRAY  (4) 

C 

000042 

REAL>t<4 

ARRAY  <4) 

IH 

000062 

INTEGER>X2 

ARRAY  <21) 

LABEL 

000134 

REALMS 

ARRAY  (4) 

NZ 

000016 

INTEGER*2 

PARAMETER 

VARIABLE 

MF 

000020 

INTEGER*2 

PARAMETER 

VARIABLE 

I  OUT 

000174 

INTEGER*2 

VARIABLE 

K 

000306 

INTEGER=t«2 

VARIABLE 

J 

000310 

INTEGER*2 

VARIABLE 

I 

000312 

INTEGER*2 

VARIABLE 

M 

000314 

INTEGER*2 

VARIABLE 

U 

000316 

REAL«4 

VARIABLE 

U2 

000322 

REAL*4 

VARIABLE 

U3 

000326 

REAL’M 

VARIABLE 

U4 

000332 

REAL«4 

VARIABLE 

V 

000336 

REAL«4 

VARIABLE 

SO 

000342 

REAL«4 

VARIABLE 

SORT 

000000 

REAL«4 

PROCEDURE 

SQ 

000346 

REAL«4 

VARIABLE 

EX 

000352 

REAL*4 

VARIABLE 

XL 

000356 

REAL*4 

VARIABLE 

XD 

000362 

REAL*4 

VARIABLE 

N 

000366 

INTEGER»2 

VARIABLE 

HISTO 

000000 

REAL*4 

PROCEDURE 

MIDfiS  FORTRAN  IV 


11  AUG  1983  5:11:14  PM 


PAGE  001 


0001  SUBROUTINE  RSTAT(NCH.P,R.NZ,MF) 

C  URITTEN  BY  T.  B.  GOSNELL  22  JUNE,  1982  LLNL 
C  MODIFIED  FOR  PREGA  BY  B.  G.  GLAGOLA  20  JULY,  1982  NRL 
C 

C  THIS  PROGRAM  ANALYSES  RESIDUALS  FROM  PREGA,  COMPUTES  A 
C  A  RESIDUAL  STATISTIC.  ITS  EXPECTATION  VALUE.  STANDARD 
C  DEVIATION  AND  AN  APPROXIMATE  ASSOCIATED  FAP. 

C 

C  REFERENCE;  A.  AARNIO.  M.  J.  KOSKELO  AND  P.  20MB0RI, 

C  NUCLEAR  INSTR.  AND  METH.  184(487)1981. 

C 

0002  DIMENSION  R(512) 

0003  REAL  NRMR 

0004  INTEGER  P 

0005  CH-NCH 

0006  EP-P 

0007  DF-CH-EP 

0008  MFl-MF-1 

0009  RSTT-0 

0010  DO  10  I-N2.MF1 

0011  RSTT>RSTT+R(I)*R(I+1) 

0012  10  CONTINUE 

0013  RSTT-RSTT+R<1)*R(MF) 

0014  RSTT=»RSTT/DF 

0015  EXRES— EP/CH 

0016  SIGRES-SQRT(CH)/DF 

0017  NRMR -CRSTT-EXRES) /SI GRES 

0018  CALL  XQCALC(DF.0.,  l..NRm,Q,l) 

0019  IJRITE(6.50) 

0020  ‘  50  FORMAT('  './///'  >io(o»iok  LLNL  R-STATISTIC  *>io(o»ok') 

0021  URITE(6.51)  RSTT.EXRES.SIGRES.NRMR.Q 

0022  51  FORMAT('0'. 'AUTO-CORRELATION  COEFFICIENT'. 17('.'),1PE12. 4/ 

r  EXPECTATION  VALUE' ,28( '.'), 1PE12.4/ 

2'  STANDARD  DEVIATION' .27(' .'). IPE12.4/ 

3'  EQUIVALENT  NORMAL  STANDARD  DEVIATIONS' ,0(' .'). 1PE12.4/ 

4'  R-STAT  FAP'.35<'.').1PE12.4) 

0023  RETURN 

0024  END 


MIDAS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

R 

000020 

REAL>K4 

PARAMETER 

ARRAY  (512) 

NCH 

000014 

INTEGER*2 

PARAMETER 

VARIABLE 

P 

000016 

INTEGER>x2 

PARAMETER 

VARIABLE 

NZ 

000022 

INTEGER*2 

PARAMETER 

VARIABLE 

MF 

000024 

INTEGER#2 

PARAMETER 

VARIABLE 

NRMR 

000404 

REAL*4 

VARIABLE 

CH 

000410 

REAL«4 

VARIABLE 

EP 

000414 

REAL»4 

VARIABLE 

DF 

000420 

REAL>M 

VARIABLE 

MFl 

000424 

INTEGER*2 

VARIABLE 

RSTT 

000426 

REAL>»<4 

VARIABLE 

I 

000432 

INTEGER>i«2 

VARIABLE 

EXRES 

000434 

REAL«4 

VARIABLE 

SI6RES 

000440 

REAL«4 

VARIABLE 

SORT 

000000 

REAL  *4 

PROCEDURE 

XQCALC 

000000 

REAL«4 

PROCEDURE 

Q 

LE 

000444 

REALM 

VARIABLE 

EX 

000352 

REALM 

VARIABLE 

XL 

000356 

REALM 

VARIABLE 

XD 

000362 

REALM 

VARIABLE 

N 

000366 

INTEGER>K2 

VARIABLE 

HISTO 

000000 

REALM 

PROCEDURE 
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0001 

C 

SUBROUTINE  RUNS(R.NZ.MF) 

(JRITEN  BY  G.  PH  ILL  IPS  JUNE  1981 

0002 

U 

DIMENSION  R (256) , IH (2 n , NCH (50) , KS I ( 12) , NRS (50) 

0003 

REAL»«  LABEL (4) 

0004 

DATA  LABEL/8H  DI,aHSTRIBUTI,8H0N  OF  RU.SHNS 

0005 

c 

DATA  KSI/'-10,-9.-8.-7,-6,-5,5.6.7,8,9. 10/ 

0006 

DO  100  K-1.21 

0007 

100 

X 

N 

(S 

0008 

I-NZ 

0009 

r 

J-0 

0010 

200 

K-0 

0011 

ICH-I 

0012 

210 

IF(R(I).LT.0.)  GOTO  300 

0014 

K-K+1 

0015 

I-I+l 

0016 

IF(I.GT.MF)  GOTO  400 

0018 

IF(R(I).GE.0.)  GOTO  210 

0020 

GOTO  400 

0021 

300 

K»K-1 

0022 

I-I  +  l 

0023 

IF(I.GT.MF)  GOTO  400 

0025 

P 

IF(R(I) .LE.0.)  GOTO  300 

0027 

400 

K-K+11 

0028 

IF(K.LT.l)  K-1 

0030 

IF(K.GT.21)  K-21 

0032 

IH(K)-IH(K)+1 

0033 

IF(K.GT.6.AND.K.LT.16)  GO  TO  450 

0035 

IF(K.GT.6)  K-K-9 

0037 

J-J+1 

0038 

NCH(J)-ICH 

0039 

NRS(J)»KSI(K) 

0040 

450 

p 

IF(I.LE.MF)  GO  TO  200 

0042 

L 

XL— 10.0 

0043 

XD-1.0 

0044 

N-21 

0045 

CALL  HISTO(LABEL.IH,XL,XD.N) 

0046 

UIRITE(6,500) 

0047 

500 

FORMATS  '.'LOCATIONS  AND  SIZES  OF  LARGE  RUNS'//) 

0048 

IJR1TE(6.501)  (NCH(I),NRS(I),I-1.J) 

0049 

501 

FOkMATC  ',5(5X.  14. 16)) 

0050 

RETURN 

0051 

END 

MIDPS  FORTRPN  IV  STORPGE  fP? 


NPME 

OFFSET 

PTTRIBUTES 

R 

000014 

REPL>K4 

PPRPMETER  PRRPY  (256) 

IH 

000022 

INTEGER*2 

PRRPY  (21) 

NCH 

000074 

INTEGER*2 

PRRPY  (50) 

KSI 

000240 

INTEGER*2 

PRRPY  (12) 

NRS 

000270 

INTEGER#2 

PRRPY  (50) 

LPBEL 

000434 

REPL*8 

PRRPY  (4) 

NZ 

000016 

INTEGER-'^ 

PPRPMETER  VPRIPBLE 

MF 

000020 

INTEGER*2 

PPRPMETER  VPRIPBLE 

K 

000564 

INTEGER»2 

VPRIPBLE 

I 

000566 

INTEGER*2 

VPRIPBLE 

J 

000570 

INTEGER*2 

VPRIPBLE 

ICH 

000572 

INTEGER*2 

VPRIPBLE 

>4. 

000574 

REPL«4 

VPRIPBLE 

XD 

000600 

REPL«4 

VPRIPBLE 

N 

000604 

INTEGER«2 

VPRIPBLE 

HISTO 

LE 

000000 

REALM 

PROCEDURE 

EX 

000352 

REPL*4 

VPRIPBLE 

XL 

000356 

REPLM 

VPRIPBLE 

XD 

000362 

REPL*4 

VPRIPBLE 

N 

000366 

INTEGER*2 

VPRIPBLE 

HISTO 

000000 

REPLM 

PROCEDURE 
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0001  SUBROUTINE  XQCALC(DF,F,ZS.X,Q, lEN) 

C 

C  URITTEN  BY  B.  G.  GLAGQLA  JUNE,  1982  NRL 

C 

C 

C  THIS  ROUTINE  CALCULATES  XCF)  AND  Q<X)  GIVEN  F 
C 


0002 

IF(IEN.EQ.l)  GO  TO  40 

0004 

DF2-2.>t<DF-l 

0005 

IF(F.GT.DF2)  GO  TO  50 

0007 

X-(SQRT(F)>K(l.-l./(4.>KDF)l)/'(SQRT(l.-F/'(2.*DF)n 

0008 

40 

IFCX.GT. 12.91  GO  TO  60 

0010 

Z  =-0 . 398942*EXP  ( -XJtoKZ/Z . ) 

0011 

T=*1.0/'(1.0+0.33267>t<X) 

0012 

Q  “Z>t‘  ( .  436 1 84*T-  .1201  68>kT*sk2+ .  937298»T*>k3  ) 

0013 

GO  TO  70 

0014 

50 

X-9.9999E09 

0015 

60 

0-0.00 

0016 

70 

IF(ZS.LT.0.0)  Q-l.-Q 

0018 

IF(2S.LT.0.0)X=-X 

0020 

RETURN 

0021 

END 

0027 

400 

K-K+11 

0028 

IF(K.LT.l)  K=1 

0030 

IF(K.GT.211  K-21 

0032 

IH(K1-IH(K)+1 

0033 

IF(K.GT.6.AND.K.LT. 16)  GO  TO  450 

0035 

IF(K.GT.6)  K-K-9 

0037 

J-J+1 

0038 

NCH(J)>ICH 

0039 

NRS(J)-KSKK) 

0040 

450 

IF.J) 

0049 

501 

FORMATt'  '.5(5X. 14. 16)) 

0050 

RETURN 

0051 

END 

MIDAS  FORTRAN  IV  STORAGE  MAP 


NAME 

OFFSET 

ATTRIBUTES 

DF 

000014 

REAL>K4 

PARAMETER 

VARIABLE 

F 

000016 

REAL*4 

PARAMETER 

VARIABLE 

ZS 

000020 

REAL«4 

PARAMETER 

VARIABLE 

X 

000022 

REAL*4 

PARAMETER 

VARIABLE 

Q 

000024 

REALM 

PARAMETER 

VARIABLE 

lEN 

000026 

INTEGER*2 

PARAMETER 

VARIABLE 

DF2 

000064 

REALM 

VARIABLE 

SORT 

000000 

REALM 

PROCEDURE 

Z 

000070 

REALM 

VARIABLE 

EX? 

000000 

REALM 

PROCEDURE 

T 

000074 

REALM 

VARIABLE 

FORVttRD  PIVOT 


CALCULATE  : 


ATIME  (ASCII  Date/Time)  Subroutine 

The  ATIME  subroutine  is  used  to  return  the  ASCII  date  and  time  to  the  FORTRAN 
user.  This  subroutine  is  written  in  assembler. 

Form 

CALL  ATIME  (string) 

String  is  the  name  of  the  24  byte  string  to  receive  the  ASCII  date/time.  The 
returned  string  is  24  bytes  in  length  in  the  following  format: 

dd-mnwryyyy  hh:mm:ss  xx 

where: 

dd  Day  (number) 

iMim  First  three  letters  of  the  month 

yyyy  Year  (number) 

hh  Hour  of  the  day  (12  hours) 

mm  Minutes  after  the  hour 

ss  Seconds  after  the  minute 

XX  AM  or  PM 

NOTE:  If  the  parameter  count  is  <1  or  >1,  then  a  return  is  made  to  MIDAS. 

Example 

LOGICAL*!  STr.iNG(24) 

CALL  ATIME(STRING) 


181 


EJ 


MTAPEF  (FORMAHED  MAGNETIC  TAPE)  SUBROUTINE 


The  MTAPEF  subroutine  controls  the  magnetic  tape  and  its  related  functions. 
The  subroutine  is  compatible  with  either  7  or  9  track  magnetic  tape.  This 
subroutine  is  written  in  Assembler. 


CALL  MTAPEF  (a,b.c,d,e) 
where: 

a  =  Command:  INTEGER*2  variable  (required  argument). 
=  1  -  Initialize  control  formatter  (a.b). 

=  2  -  Transport  off-line  (a.b). 

=  3  -  Rewind  (a.b). 

=  4  -  Search  for  logical  EOT  (a.b). 

=  5  -  Search  for  file  (a.b.c). 

=  6  -  Search  for  record  (a.b.c). 

=  7  -  Read  one  record  (a.b.c.d.e). 

=  8  -  Verify  one  record  U«b.c.d.e). 

=  9  -  Write  one  record  (a.b.c.d). 

-  10  -  Not  used. 

=  11  -  Over  write  one  record  (a.b.c.d). 

=  12  -  Dump  one  record  (a.b.c.d). 

=  13  -  Write  one  filemark  (a.b). 

=  14  -  Write  a  logical  EOT  (a.b). 

~  15  -  Open  transport  (a.b.c). 

*  16  -  Close  transport  (a.b). 

=  17  -  Tagword  (a.b.c.d) 

b  =  Error  Number:  INTEGER*2  variable  (required). 

=  1  -  No  error. 

=  2  -  Transport  assigned  to  other/or  no  user. 

=  3  -  Magnetic  tape  transport  number  error. 

=  4  -  Segment  is  read  only. 

=  5  -  Segment  is  not  accessible  for  I/O. 

=  6  -  Memory  is  not  contiguous. 

=  7  ~  Cross  segments  have  different  status. 

-  8  -  No  filemark  detected  for  last  operation. 

=  9  -  Filemark  detected  during  last  operation. 

=  10  -  Located  on  or  past  physical  EOT. 

=  11  -  Record  read  less  than  list  word  #14. 

-  12  “  Record  read  greater  than  list  word  #14. 

=  13  -  Invalid  or  undefined  OP  code. 

-  14  -  Data  late. 

*  15  -  Invalid  password, 

s  16  -  Motion  error. 

*  17  -  Verification  error. 

*  18  -  Write  protect  error. 

*  19  -  Parity  CRC  or  LRC  error  during  read. 

=  20  -  Operation  attempt  on  off-line  transport. 

-  21  -  No  logical  EOT  detected  during  operation. 


-  22  -  Logical  EOT  detected  during  operation, 
s  23  -  Magnetic  tape  not  off-line. 

-  24  -  Undefined  error  bit  in  status. 

=  25  -  Executive  error  during  operation, 
s  26  -  Illegal  number  of  arguments. 

-  27  -  Illegal  command  number. 

-  28  -  Record  length  greater  than  513  bytes  for  7  track  transport, 
s  Command  Parameter  1:  INTEGER*2  variable. 


Command  Number  Parameter 

5  #  files  to  skip 

6  #  records  to  skip 

7  #  bytes  to  skip 

8  #  bytes  to  skip 

9  #  bytes  to  write 

11  #  bytrs  to  write 

12  -  #  bytes  to  write 

15  #  transport  to  open 

17  Subcommand  code  (c) 

c  =  1  -  Get  tagword 
c  =  2  -  Increment  tagword 
c  =  3  -  Put  tagword 

d  =  Command  Parameter  2:  INTEGER*2  variable  or  array  name. 


Command  Nimiber 


Parameter 

#  bytes  to  read 

#  bytes  to  verify 
Array  name  to  write 
Array  name  to  write 
Array  name  to  write 

Get,  Increment,  or  Put  tagword 


e  =  Command  parameter  3:  Integer  variable. 


Command  Number  Parameter 

7  Array  name  to  read 

8  Array  name  to  verify 

The  following  is  a  test  program  for  MTAPEF. 

things: 

1.  Opens  transport. 

2.  Initializes  magnetic  tape  controller. 


the  program  does  the  following 


3.  Reads  from  the  disk  and  writes  to  the  tape  4096  channels  in  groups  of  128 
channels. 


4.  Writes  logical  end  of  tape  (of  double  filemark). 

5.  Rewinds  tape. 

6.  Reads  from  tape  and  writes  to  disk  4096  channels  In  groups  of  128 
channels. 

7.  Rewinds  tape. 

8.  Closes  transport. 

C  PROGRAM  TO  TEST  HAG  TAPE  OPERATIONS 

C  USING  FORTRAN  EXTENSION  LIBRARY  SUBROUTINE 

C 

INTEGER  ARRAY  (513)  A.B.C.O 
DEFINE  FILE  12(4096,2.U,IVAR) 

C 

C  OPEN  FILE 

C 

A=15 

C=1 

CALL  MTAPEF(A,B.C) 

IO(B.NE.1)WRITE(6,110)B 

C 

C  INITIALIZE  MAG  TAPE 

C 

A=1 

CALL  MTAPEF(A,B) 

IF(B.NE.1)WRITE(6,100)B 

C 

C  NOW  READ  THE  DISK  &  WRITE  TO  MAG  TAPE 

C 

A=9 
C=i513 
IVAR=129 
00  200  1=1,16 
DO  300  J=l,512,2 

300  REA0(12'  IVAR)ARRAY(J)  ,ARRAY(J->'1) 

CALL  MTAPEF(A,B,C. ARRAY) 

IF(B.PjE.l)WRITE(6,120)B 
200  CONTINUE 

C 

C  WRITE  A  DOUBLE  FILEMARK 

C 

A=14 

CALL  MTAPEF(A,B) 

IF(B.NE.1)WRITE(6.130)B 

C 

C  REWIND  TAPE 

C 

A=3 

CALL  MTAPEF(A,B) 

IF  (B.NE.1)WRITE(6.140)B 


c 

C  NOW  READ  FROM  TAPE  &  WRITE  TO  DISK 

C 

A=7 

0*513 

IVAR=129 

00  400  1=1,16 

CALL  MTAPEF(A,B.C,0,ARRAY) 

IF(B.NE.1)WRITE(6,150)B 
00  500  0=1,512,2 

500  REA0(12'IVAR)ARRAY(J).ARRAY(J+1) 

400  CONTINUE 

C 

C  REWINO  TAPE 

C 

A=3 

CALL  MTAPEF(A,B) 

IF(B.NE.1)WRITE(6,160)B 

C 

C  00  A  CLOSE 

C 

A=16 

CALL  MTAPEF(A,B) 

IF(B.NE.1)WRITE(6.170)B 

C 

C 

100  FORMATC  ERROR  ',13,'  IN  MAG  TAPE  INITIALIZE’) 

110  FORMATC  ERROR  ',13,'  IN  MAG  TAPE  OPEN' ) 

120  FORMAT( '  ' , ' ERROR  ' ,13, '  IN  MAG  TAPE  WRITE’ ) 

130  FORMATC  ', 'ERROR  ',13,'  IN  SETTING  FILE  MARK') 

140  FORMATC '  ' , ' ERROR  ' ,  13 , '  IN  FIRST  REWiNO ' ) 

150  FORMATC  ',' ERROR  ',13,'  IN  MAG  TAPE  REAO') 

160  FORMATC  ',' ERROR  ',13,'  IN  SECONO  MAG  TAPE  REWINO’) 

170  FORMATC  ERROR  ',13,'  ERROR  IN  MAG  TAPE  CLOSE') 

END 


CLOSEU  (Close  with  Update)  Subroutine 

This  subroutine  closes  a  file  with  update  and  moves  the  current  end  sector  to 
the  current  end  of  the  file.  This  subroutine  Is  written  In  assembler. 

Form 

CALL  CLOSEU(lun) 
where: 

lun  =  Logical  unit  number  associated  with  the  file. 


System  Subroutines 


CONCAT 


CONCAT 


The  CONCAT  subroutine  is  used  to  concatenate  character 
strings. 


Form: 


Where: 


CALL  CONCAT  (a,b,out(,len{,  err))  ) 


is  the  array  containing  the  left  string 

is  the  array  containing  the  right  string. 

is  the  array  into  which  the  concatenated 
result  is  placed.  This  array  must  be  at 
least  one  element  longer  than  the 
maximum  length  of  the  result  string  (i.  e. 
one  greater  than  the  value  of  len,  if 
specified). 

is  the  integer  number  of  characters 
representing  the  maximum  length  of  the 
output  string.  The  effect  of  len  is  to 
truncate  the  output  string  to  a  given 
length,  if  necessary, 
is  the  Logical  error  flag  set  if  the 
output  string  is  truncated  to  the  length 
specified  by  len. 


The  string  in  array  "a"  immediately  followed  on  the  right  by  the 
string  in  array  "b"  and  a  terminating  null  character  replaces  the 
string  in  array  "out".  Any  combination  of  string  arguments  is 
allowed  so  long  as  "b"  and  "out"  do  not  specify  the  same  array. 
Concatenation  stops  either  when  a  null  character  is  detected  in  "b" 
or  when  the  number  of  characters  specified  by  "len"  have  been 
moved. 

If  whether  the  left  or  right  string  is  a  null  string,  the  other  string 
is  copied  to  "out".  If  both  are  null  strings,  then  "out"  is  set  to  a 
null  string.  The  old  contents  of  "out"  are  lost  when  this  routine  is 
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Errors: 

Error  conditions  are  indicated  by  "err",  if  specified.  If  "err" 
is  given  and  the  output  string  would  have  been  longer  than  "len" 
characters,  then  "err*  is  set  to  .TRUE.;  otherwise,  "err"  is 
unchanged. 

Example: 

The  following  example  concatenates  the  string  in  array  STR  and 
the  string  in  array  IN  and  stores  the  resultant  string  in  array  OUT. 
OUT  cannot  be  larger  than  29  characters. 

LOGICAL=!‘l  IN(30),OUT(30),STR(7) 


CALL  CONCAT(STR,  IN,  OUT,  29) 
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LUNDEF:  SAVE  RQ.R1.R2.R3.R4,R5 
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